From: ivan Date: Sun, 2 Mar 2008 04:11:51 +0000 (+0000) Subject: This commit was generated by cvs2svn to compensate for changes in r6255, X-Git-Tag: TRIXBOX_2_6~36 X-Git-Url: http://git.freeside.biz/gitweb/?a=commitdiff_plain;h=c648976f0b7975f2328ebd7ba8c711fad0ca4195;hp=8103c1fc1b2c27a6855feadf26f91b980a54bc52;p=freeside.git This commit was generated by cvs2svn to compensate for changes in r6255, which included commits to RCS files with non-trunk default branches. --- diff --git a/AGPL b/AGPL new file mode 100644 index 000000000..939a6f41f --- /dev/null +++ b/AGPL @@ -0,0 +1,662 @@ + GNU AFFERO GENERAL PUBLIC LICENSE + Version 3, 19 November 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU Affero General Public License is a free, copyleft license +for software and other kinds of works, specifically designed to ensure +cooperation with the community in the case of network server software. + + The licenses for most software and other practical works are +designed to take away your freedom to share and change the works. By +contrast, our General Public Licenses are intended to guarantee your +freedom to share and change all versions of a program--to make sure it +remains free software for all its users. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + Developers that use our General Public Licenses protect your rights +with two steps: (1) assert copyright on the software, and (2) offer +you this License which gives you legal permission to copy, distribute +and/or modify the software. + + A secondary benefit of defending all users' freedom is that +improvements made in alternate versions of the program, if they +receive widespread use, become available for other developers to +incorporate. Many developers of free software are heartened and +encouraged by the resulting cooperation. However, in the case of +software used on network servers, this result may fail to come about. +The GNU General Public License permits making a modified version and +letting the public access it on a server without ever releasing its +source code to the public. + + The GNU Affero General Public License is designed specifically to +ensure that, in such cases, the modified source code becomes available +to the community. It requires the operator of a network server to +provide the source code of the modified version running there to the +users of that server. Therefore, public use of a modified version, on +a publicly accessible server, gives the public access to the source +code of the modified version. + + An older license, called the Affero General Public License and +published by Affero, was designed to accomplish similar goals. This is +a different license, not a version of the Affero GPL, but Affero has +released a new version of the Affero GPL which permits relicensing under +this license. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU Affero General Public +License. + + "Copyright" also means copyright-like laws that apply to other kinds +of works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further restriction, +you may remove that term. If a license document contains a further +restriction but permits relicensing or conveying under this License, you +may add to a covered work material governed by the terms of that license +document, provided that the further restriction does not survive such +relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Remote Network Interaction; Use with the GNU General Public License. + + Notwithstanding any other provision of this License, if you modify the +Program, your modified version must prominently offer all users +interacting with it remotely through a computer network (if your version +supports such interaction) an opportunity to receive the Corresponding +Source of your version by providing access to the Corresponding Source +from a network server at no charge, through some standard or customary +means of facilitating copying of software. This Corresponding Source +shall include the Corresponding Source for any work covered by version 3 +of the GNU General Public License that is incorporated pursuant to the +following paragraph. + + Notwithstanding any other provision of this License, you have permission +to link or combine any covered work with a work licensed under version 3 +of the GNU General Public License into a single combined work, and to +convey the resulting work. The terms of this License will continue to +apply to the part which is the covered work, but the work with which it is +combined will remain governed by version 3 of the GNU General Public +License. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU Affero General Public License from time to time. Such new +versions will be similar in spirit to the present version, but may differ +in detail to address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU Affero +General Public License "or any later version" applies to it, you have +the option of following the terms and conditions either of that +numbered version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number +of the GNU Affero General Public License, you may choose any version +ever published by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU Affero General Public License can be used, that +proxy's public statement of acceptance of a version permanently +authorizes you to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as + published by the Free Software Foundation, either version 3 of the + License, or (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If your software can interact with users remotely through a computer +network, you should also make sure that it provides a way for users to +get its source. For example, if your program is a web application, its +interface could display a "Source" link that leads users to an archive +of the code. There are many ways you could offer source, and different +solutions will be better for different programs; see section 13 for the +specific requirements. + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU AGPL, see +. diff --git a/CREDITS b/CREDITS new file mode 100644 index 000000000..15f1aa935 --- /dev/null +++ b/CREDITS @@ -0,0 +1,178 @@ +Thanks to Matt Simerson of MichWeb Inc. for documentation +and pre-release testing. Without his help the documentation in 1.0.0 +release would have consisted of a single screenfull of text. +(To clear up some misunderstanding, Matt did not write the current +documentation.) + +Steve Cleff did the default background image in 1.0.x and +is also the creator of Freeside's elusive mascot, Snakeman, who we hope will +make an appearance in an upcoming version. + +Jerry St. Pierre did the "SISD" graphic used in +1.0.x and most of 1.1.x. + +Mark Norris of Urban Design, Inc. did the red "S" +logo for later 1.1.x versions until 1.4.1 + +Brian McCane? contributed PostgreSQL support, HTML +style enhancements and many, many bugfixes. + +Cerkit contributed rsync support and desynced hosts. +His changes will hopefully be included in an upcoming version. + +CompleteHOST, Inc. (http://www.completehost.com) funded the development of the +following features: + - Multiple, separate databases and configurations on one box. + - Per-customer pricing (custom packages) + - Internationalization wrt addresses (cust_main, cust_main_county) +Thanks! + +Mark Williamson and Roger Mangraviti + contributed state/provence listings for Australia. + +Peter Wemm sent in a bunch of bugfixes for the 1.2 +release. + +Greg Kuhnert sent some documentation updates. + +Joel Griffiths contribued many bugfixes as well as +the print-batch script. + +NetLoud funded the development of the following +features: + - IEAK support for the signup server + - Pre-payment support + +NetAcces.Net (not netaccess.net) funded the development of the following +features: + - DNS tracking and export to BIND configuration files + - Web site virtual host tracking and export to Apache configuration files + +Kristian Hoffmann contributed Netscape CCK +autoconfiguration support for the signup server, lots of great mailing +lists posts which I shamelessly made into documentation, fixes to get rid of +the embarassing and non-database-normal "owed" field, and many other things +I'm forgetting. Most recently Kristian and Mark (last name?) contributed +the IP address tracking and svc_broadband in 1.5. + +Jeff Finucane send in a bunch of bugfixes (for the sendmail +export, cancel-unaudited.cgi), patches to support billing date modification, +and probably other things too (sorry if I forgot them). And yet even more +bug squashing, thanks! *and* he single-handedly implemented all the necessary +work to get rid of svc_acct_sm and the "default domain" thanks!! and rewrote +the financials! wow, thanks jeff! and contributed financial reports! + +Kenny Elliott contributed ICRADIUS radreply table support, +allowing attributes with ICRADIUS, helped fix many bugs, and some +other stuff I can't recall (sorry). + +Stephen Amadei contribued portability cleanups for the +low-level DBI stuff. + +Jason Spence contributed admin.html and other +documentation, autocapnames javascript, bugfixes & other neat stuff I can't +remember. + +Brad Dameron contributed code to do configurable state +and referral defaults. + +Surf and Sip, Inc., sponsored a long-requested +feature - the session monitor and time-based prepaid cards. +Matt Peterson and Mack ? tested +the new features and contributed many bugfixes. + +Landel Telecom sponsored shipping addresses and +customer notes, as well as an update of the CP provisioning. + +nikotel, Inc. sponsored the inclusion of +customer-to-customer referrals in the web interface and signup server. + +Three Bubba's Innanet sponsored expedited check entry, +the "similar names warning" feature, and a number of other enhancements. + +Dave Burgess sent in a bunch of fixes and small changes +and will doubtless send more once he's got his tree under control. + +Luke Pfeifer contributed the "subscription" price plan. + +Noment Networks, LLC sponsored ICRADIUS/FreeRADIUS +groups, message catalogs, and signup server enhancements. + +Donald Greer provided the SQL to work around MySQL's lack +of subqueries, and Dale Hege provided the patches. +Thanks! + + sent in several documentation patches. + +"Stephen Bechard" sent in patches for svc_www services and +other fixes. + +Charles A Beasley contributed quota editing for the +Infostreet export. + +Richard Siddall sent in Mason fixes, fixed lots +of typos, mod_perl 2.0 work, RPM packaging and other things I'm probably +forgetting. + +Contains "JS Calendar" +by Mihai Bazon licensed under the terms of the GNU LGPL. + +Latex invoice template based on a template from eBills + by Mark Asplen-Taylor , +licensed under the terms fo the GNU GPL. + +Contains "Request Tracker" and +"RTx::Extension::ActivityReports" from Best Practical Solutions, licensed under +the terms of the GNU GPL. + +Contains "RTx::Statistics Package" + from Kelly Hickel +, licensed under the same terms as Perl (GPL/Artistic). + +Contains "RTx::WebCronTool" from +Audrey Tang, licensed under the same terms as Perl (GPL/Artistic). + +#not yet used... +# Contains "SQL Ledger" by DWS Systems Inc. and +# contributors licensed under the terms of the GNU GPL. + +Peter Bowen started the difficult modular price plans +changes, added credit card encryption features, and other things I've +probably overlooked. + +Rebecca Cardennis created the great new logo first +released with 1.4.2beta1 and 1.5.0pre6. + +Troy Hammonds sent in RADIUS session history viewing, +many bugfixes and other things I'm probably forgetting. + +Contains the QLIB JavaScript library by +Quazzle.com, Serge Dolgov, licensed under the terms of the GNU GPL. + +Contains the overlibmws DHTML Popup Library +by Foteos Macrides (derived from overLIB +by Erik Bosrup), licensed under the terms of the Artistic license +. + +Ricardo SIGNES has contributed a bunch of +patches to clean up and refactor various stuff in the module layer. Thanks! + +XMLHttpRequest implementation based on the SAJAX toolkit, licensed under the +terms of the BSD license. +(c) copyright 2005 modernmethod, inc +Perl backend version (c) copyright 2005 Nathan Schmidt + +Scott Edwards contributed magic for XMLHTTP error +handling, and other patches. + +Contains XMenu +by Erik Arvidsson, licensed under the terms of the GNU GPL. + +Contains public domain artwork from openclipart.org by mimooh and other +authors. + +Contains FCKeditor by Frederico Caldeira Knabben, licensed under the terms of +the GNU GPL. + +Everything else is my (Ivan Kohler ) fault. + diff --git a/FS/Changes b/FS/Changes new file mode 100644 index 000000000..c94ef10f5 --- /dev/null +++ b/FS/Changes @@ -0,0 +1,5 @@ +Revision history for Perl extension FS. + +0.01 Wed Aug 4 00:13:45 1999 + - original version; created by h2xs 1.19 + diff --git a/FS/FS.pm b/FS/FS.pm new file mode 100644 index 000000000..6fa6faa52 --- /dev/null +++ b/FS/FS.pm @@ -0,0 +1,428 @@ +package FS; + +use strict; +use vars qw($VERSION); + +$VERSION = '%%%VERSION%%%'; + +#find missing entries in this file with: +# for a in `ls *pm | cut -d. -f1`; do grep 'L' ../FS.pm >/dev/null || echo "missing $a" ; done + +1; +__END__ + +=head1 NAME + +FS - Freeside Perl modules + +=head1 SYNOPSIS + +Freeside perl modules and CLI utilities. + +=head2 Utility classes + +L - Freeside database schema + +L - Setup subroutines + +L - Upgrade subroutines + +L - Freeside configuration values + +L - Freeside configuration option meta-data. + +L - Freeside configuration default and available values + +L - User class (not yet OO) + +L - Package representing the current user + +L - Non OO-subroutines for the web interface. + +L - Message catalog + +L - Search cache + +L - Access control rights. + +L - Report data objects + +L - Report data objects + +L - Report data objects + +L - Backend XML::RPC server + +L - Miscellaneous subroutines + +L - Payment types + +L - ClientAPI session cache + +L - A pony + +=head2 Database record classes + +L - Database record base class + +L - Mixin class for classes in a many-to-many relationship + +L - Base class for tables with a related table listing names + +L - Base class for option sub-classes + +L - Configuration value class + +L - Mixin class for records in tables that contain payinfo. + +L - Employees / internal users + +L - Employee preferences + +L - Employee groups + +L - Employee group membership + +L - Group reseller access + +L - Access rights + +L - POP (Point of Presence, not Post +Office Protocol) class + +L - Local calling area class + +L - Referral class + +L - Package referral class + +L - Locale (tax rate) class + +L - Tax exemption record class + +L - Line-item specific tax exemption record class + +L - Service base class + +L - Mixin class for svc_ classes with a parent_svcnum field + +L - Account (shell, RADIUS, POP3) class + +L - External mail account class + +L - Time worked application to account class + +L - RADIUS groups + +L - Domain class + +L - DNS zone entries + +L - Domain registrar class + +L - Mail forwarding class + +L - Web virtual host class. + +L - DSL, wireless and other broadband class. + +L - Address block class + +L - Router class + +L - Broadband virtual field class + +L - Phone service class + +L - Call Detail Record class + +L - CDR calltype class + +L - CDR carrier class + +L - CDR upstream rate class + +L - CDR type class + +L - Externally tracked service class. + +L - Inventory classes + +L - Inventory items + +L - Service definition class + +L - Column constraint class + +L - Class linking service definitions (see L) +with exports (see L) + +L - External provisioning export class + +L - Export option class + +L - Package class class + +L - Package definition class + +L - Tax class class + +L - Package definition option class + +L - Class linking package definitions (see L) with +service definitions (see L) + +L - One-time registration codes + +L - Class linking registration codes (see L) with package definitions (see L) + +L - Rate plans for call billing + +L - Rate regions for call billing + +L - Rate region prefixes for call billing + +L - Rate plan detail for call billing + +L - Agent (reseller) class + +L - Agent type class + +L - Class linking agent types (see L) with package definitions (see L) + +L - Payment gateway class + +L - Payment gateway option class + +L - Agent payment gateway class + +L - Service class + +L - Customer package class + +L - Customer package option class + +L - Reason type class + +L - Reason class + +L - Package reason class + +L - Customer class + +L - Mixin class for records that contain fields from cust_main + +L - Invoice destination class + +L - Customer note class + +L - Banned payment information class + +L - Invoice class + +L - Invoice line item class + +L - Invoice line item detail class + +L - (Old) Invoice event definition class + +L - (Old) Completed invoice event class + +L - (New) Billing event definition class + +L - (New) Billing event option class + +L - (New) Billing event condition base class + +L - (New) Billing event action base class + +L - (New) Billing event condition class + +L - (New) Billing event condition option class + +L - (New) Billing event condition compound option class + +L - (New) Customer event class + +L - Base class for bill application classes + +L - Payment class + +L - Pending payment class + +L - Voided payment class + +L - Payment application class + +L - Line-item specific payment application class + +L - Batch payment application class + +L - Credit class + +L - Refund class + +L - Refund application to credit class + +L - Credit application to invoice class + +L - Line-item specific credit application to invoice class + +L - Refund application to payment class + +L - Credit card transaction queue class + +L - Credit card transaction member queue class + +L - Prepaid "calling card" credit class. + +L - Network Access Server class + +L - NAS port class + +L - User login session class + +L - Job queue + +L - Job arguments + +L - Job dependencies + +L - Message catalogs + +L + +L + +=head2 Historical database record classes + +L - History table base class + +L - Historical record of customer payment changes + +L - Historical record of customer credit changes + +L - Historical record of customer tax changes (old-style) + +L - Object method for h_cust_svc objects + +L - Historical record of customer tax changes (old-style) + +L - Historical DNS entry objects + +L - Historical account objects + +L - Historical broadband connection objects + +L - Historical domain objects + +L - Historical externally tracked service objects + +L - Historical mail forwarding alias objects + +L - Historical phone number objects + +L - Historical web virtual host objects + +=head2 Remote API modules + +L - Self-service API + +L - Self-service XML-RPC API + +=head2 User Interface classes + +L - Web user-interface class + +L - Byte counter user-interface class + +=head2 Command-line utilities + +L - Command line interface to add (freeside) users. + +L - Run daily billing and collection events. + +L - Run monthly billing and invoice collection events. + +L - Recreate database schema cache + +L - Command line interface to delete (freeside) users. + +L - Emails notifications of credit card expirations. + +L - Prints email addresses of all users on STDOUT + +L - Send a freeside page to a list of employees. + +L - Real-time daemon for prepaid packages + +L - Removes stray applications of credit, payment to bills, refunds, etc. + +L - Job queue daemon + +L - Command line utility to manipulate radius groups + +L - Command line tool to re-trigger export jobs for existing services + +L - Command line tool to set the fixed columns for existing services + +L - Command line tool to eliminate duplicate usergroup entries from radius tables + +L - Real-time radacct import daemon + +L - Command line interface to reset and recreate RADIUS SQL tables + +L - Command line time-online tool + +L - Upgrades database schema for new freeside verisons. + +=head1 Notes + +To quote perl(1), "If you're intending to read these straight through for the +first time, the suggested order will tend to reduce the number of forward +references." + +If you've never used OO modules before, +http://www.perl.com/doc/FMTEYEWTK/easy_objects.html might help you out. + +=head1 DESCRIPTION + +Freeside is a billing and administration package for wired and wireless ISPs, +VoIP, hosting, service and content providers and other online businesses. + +The Freeside home page is at . + +The main documentation is at . + +=head1 SUPPORT + +A mailing list for users is available. Send a blank message to + to subscribe. + +A mailing list for developers is available. It is intended to be lower volume +and higher SNR than the users list. Send a blank message to + to subscribe. + +Commercial support is available; see +. + +=head1 AUTHORS + +Primarily Ivan Kohler, with help from many kind folks, including core +contributors Jeff Finucane, Kristian Hoffman, Jason Hall and Peter Bowen. + +See the CREDITS file in the Freeside distribution for a (hopefully) complete +list and the individal files for details. + +=head1 SEE ALSO + +perl(1), main Freeside documentation at + +=head1 BUGS + +Those modules which would be useful separately should be pulled out, +renamed appropriately and uploaded to CPAN. So far: DBIx::DBSchema, Net::SSH +and Net::SCP... + +=cut + diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm new file mode 100644 index 000000000..13dbd7f5b --- /dev/null +++ b/FS/FS/AccessRight.pm @@ -0,0 +1,295 @@ +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', + + ### + # basic customer rights + ### + 'Customer rights' => [ + 'New customer', + 'View customer', + #'View Customer | View tickets', + 'Edit customer', + 'Cancel customer', + 'Complimentary customer', #aka users-allow_comp + { 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 + 'Add customer note', #NEW + 'Edit customer note', #NEW + 'Bill customer now', #NEW + ], + + ### + # 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', + 'Customize customer package', + 'Suspend customer package', + 'Suspend customer package later', + 'Unsuspend customer package', + 'Cancel customer package immediately', + 'Cancel customer package later', + 'Add on-the-fly cancel reason', #NEW + 'Add on-the-fly suspend reason', #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 + + { 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 + 'View customer tax exemptions', #yow + 'View customer batched payments', #NEW + 'View customer billing events', #NEW + ], + + ### + # customer payment rights + ### + 'Customer payment rights' => [ + 'Post payment', + 'Post payment batch', + 'Apply payment', #NEWNEW + { rightname=>'Unapply payment', desc=>'Enable "unapplication" of unclosed payments from specific invoices.' }, #aka. unapplypayments + 'Process payment', + 'Refund 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. + '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 + + + ], + + ### + # report/listing rights... + ### + 'Reprting/listing rights' => [ + 'List customers', + 'List zip codes', #NEW + 'List invoices', + 'List packages', + 'List services', + + { rightname=> 'List rating data', desc=>'Usage reports', global=>1 }, + 'Billing event reports', + 'Financial reports', + ], + + ### + # 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=>'Import', global=>1 }, #some of these are ag-virt'ed now? give em their own ACLs + { rightname=>'Export', 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 }, + + { rightname=>'Configuration', global=>1 }, #most of the rest of the configuraiton is not agent-virtualized + ], + +; + +=head1 CLASS METHODS + +=over 4 + +=item rights + +Returns a list of right names. + +=cut + + sub rights { + #my $class = shift; + map { ref($_) ? $_->{'rightname'} : $_ } map @{ $rights{$_} }, keys %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, L, L + +=cut + +1; + diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm new file mode 100644 index 000000000..38a869ccd --- /dev/null +++ b/FS/FS/CGI.pm @@ -0,0 +1,425 @@ +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 + small_custview 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 = < + + + $title + + + + + + + +
$title
+
+
+END + $x .= $menubar. "

" 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!$item!; + } + 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 < + + Error processing your request + + + + + +
+

Error processing your request

+
+ Your request could not be processed because of the following error: +

$error + + +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 + +Returns current URL with LEVEL levels of path removed from the end (default 0). + +=cut + +sub popurl { + my($up)=@_; + my $cgi = &FS::UID::cgi; + my $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 { + # better to start with the client-provided URL + my $cgi = &FS::UID::cgi; + my $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!!; + } else { + '
'; + } +} + +=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!
!; + } else { + qq!
!; + } +} + +=item ntable + +This is getting silly. + +=cut + +sub ntable { + my $col = shift; + my $cellspacing = shift || 0; + if ( $col ) { + qq!
!; + } else { + '
'; + } + +} + +=item small_custview CUSTNUM || CUST_MAIN_OBJECT, COUNTRYDEFAULT, NOBALANCE_FLAG, URL + +Sheesh. I should just switch to Mason. + +=cut + +sub small_custview { + use FS::Record qw(qsearchs); + use FS::cust_main; + + 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 ' + if $url; + + $html .= 'Customer #'. $cust_main->custnum. ''. + ' - '. + ucfirst($cust_main->status). ''. + ntable('#e8e8e8'). '
'. ntable("#cccccc",2). + '
Billing
Address
'. + $cust_main->getfield('last'). ', '. $cust_main->first. '
'; + + $html .= $cust_main->company. '
' if $cust_main->company; + $html .= $cust_main->address1. '
'; + $html .= $cust_main->address2. '
' if $cust_main->address2; + $html .= $cust_main->city. ', '. $cust_main->state. ' '. $cust_main->zip. '
'; + $html .= $cust_main->country. '
' + if $cust_main->country && $cust_main->country ne $countrydefault; + + $html .= '
'; + if ( $cust_main->daytime && $cust_main->night ) { + use FS::Msgcat; + $html .= ( FS::Msgcat::_gettext('daytime') || 'Day' ). + ' '. $cust_main->daytime. + '
'. ( 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 .= '
Fax '. $cust_main->fax; + } + + $html .= '
'; + + if ( defined $cust_main->dbdef_table->column('ship_last') ) { + + my $pre = $cust_main->ship_last ? 'ship_' : ''; + + $html .= ''. ntable("#cccccc",2). + 'Service
Address'. + $cust_main->get("${pre}last"). ', '. + $cust_main->get("${pre}first"). '
'; + $html .= $cust_main->get("${pre}company"). '
' + if $cust_main->get("${pre}company"); + $html .= $cust_main->get("${pre}address1"). '
'; + $html .= $cust_main->get("${pre}address2"). '
' + if $cust_main->get("${pre}address2"); + $html .= $cust_main->get("${pre}city"). ', '. + $cust_main->get("${pre}state"). ' '. + $cust_main->get("${pre}ship_zip"). '
'; + $html .= $cust_main->get("${pre}country"). '
' + if $cust_main->get("${pre}country") + && $cust_main->get("${pre}country") ne $countrydefault; + + $html .= ''; + + 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"). + '
'. ( 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 .= '
Fax '. $cust_main->get("${pre}fax"); + } + + $html .= ''; + } + + $html .= ''; + + $html .= '
Balance: $'. $cust_main->balance. '
' + unless $nobalance; + + # last payment might be good here too? + + $html; +} + +=back + +=head1 BUGS + +Not OO. + +Not complete. + +small_custview sooooo doesn't belong here. i should just switch to Mason. + +=head1 SEE ALSO + +L, L + +=cut + +1; + + diff --git a/FS/FS/ClientAPI.pm b/FS/FS/ClientAPI.pm new file mode 100644 index 000000000..902f58b31 --- /dev/null +++ b/FS/FS/ClientAPI.pm @@ -0,0 +1,37 @@ +package FS::ClientAPI; + +use strict; +use vars qw(%handler $domain $DEBUG); + +$DEBUG = 0; + +%handler = (); + +#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 new file mode 100644 index 000000000..daede59a8 --- /dev/null +++ b/FS/FS/ClientAPI/Agent.pm @@ -0,0 +1,125 @@ +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 qw(smart_search); + +sub _cache { + $cache ||= new FS::ClientAPI_SessionCache( { + 'namespace' => 'FS::ClientAPI::Agent', + } ); +} + +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 + ], + } + +} + +1; diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm new file mode 100644 index 000000000..2d3951006 --- /dev/null +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -0,0 +1,1291 @@ +package FS::ClientAPI::MyAccount; + +use strict; +use vars qw($cache); +use subs qw(_cache); +use Digest::MD5 qw(md5_hex); +use Date::Format; +use Business::CreditCard; +use Time::Duration; +use FS::CGI qw(small_custview); #doh +use FS::UI::Web; +use FS::UI::bytecount; +use FS::Conf; +use FS::Record qw(qsearch qsearchs); +use FS::Msgcat qw(gettext); +use FS::Misc qw(card_types); +use FS::ClientAPI_SessionCache; +use FS::svc_acct; +use FS::svc_domain; +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; + +#false laziness with FS::cust_main +BEGIN { + eval "use Time::Local;"; + die "Time::Local minimum version 1.05 required with Perl versions before 5.6" + if $] < 5.006 && !defined($Time::Local::VERSION); + eval "use Time::Local qw(timelocal_nocheck);"; +} + +use vars qw( @cust_main_editable_fields ); +@cust_main_editable_fields = qw( + first last company address1 address2 city + 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 +); + +use subs qw(_provision); + +sub _cache { + $cache ||= new FS::ClientAPI_SessionCache( { + 'namespace' => 'FS::ClientAPI::MyAccount', + } ); +} + +#false laziness w/FS::ClientAPI::passwd::passwd +sub login { + my $p = shift; + + 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; + + my $conf = new FS::Conf; + 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 password.' } + unless $svc_acct->check_password($p->{'password'}); + + my $session = { + 'svcnum' => $svc_acct->svcnum, + }; + + my $cust_pkg = $svc_acct->cust_svc->cust_pkg; + if ( $cust_pkg ) { + my $cust_main = $cust_pkg->cust_main; + $session->{'custnum'} = $cust_main->custnum; + } + + 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 { 'error' => '' }; + } else { + return { 'error' => "Can't resume session" }; #better error message + } +} + +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" }; + + $return{balance} = $cust_main->balance; + + $return{tickets} = [ ($cust_main->tickets) ]; + + 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, $conf->config('countrydefault') ); + + $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; + } + + } 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; + + if ( $payinfo eq $cust_main->paymask ) { + $new->payinfo($cust_main->payinfo); + } else { + $new->payinfo($payinfo); + } + + $new->set( 'payby' => $p->{'auto'} ? 'CHEK' : 'DCHK' ); + + }elsif ( $payby =~ /^(BILL)$/ ) { + } 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 + ## + + use vars qw($payment_info); #cache for performance + unless ( $payment_info ) { + + my $conf = new FS::Conf; + my %states = map { $_->state => 1 } + qsearch('cust_main_county', { + 'country' => $conf->config('countrydefault') || 'US' + } ); + + $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') ], + + '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'), + }; + + } + + ## + #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{balance} = $cust_main->balance; + + $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; + + } + + #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->{'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'} =~ /^([A-Z]{4})$/ + or return { 'error' => "illegal_payby " . $p->{'payby'} }; + my $payby = $1; + + 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'}; + $payinfo =~ s/[^\dx]//g; + $payinfo =~ /^(\d{13,16})$/ + or return { 'error' => gettext('invalid_card') }; # . ": ". $self->payinfo + $payinfo = $1; + + $payinfo = $cust_main->payinfo + if $cust_main->paymask eq $payinfo; + + validate($payinfo) + or return { 'error' => gettext('invalid_card') }; # . ": ". $self->payinfo + return { 'error' => gettext('unknown_card_type') } + if 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 address1 address2 city state zip payip ) ], + 'CHEK' => [ qw( ss paytype paystate stateid stateid_state payip ) ], + ); + + my $error = $cust_main->realtime_bop( $FS::payby::payby2bop{$payby}, $p->{'amount'}, + 'quiet' => 1, + 'payinfo' => $payinfo, + 'paydate' => $p->{'year'}. '-'. $p->{'month'}. '-01', + 'payname' => $payname, + 'paybatch' => $paybatch, + 'paycvv' => $paycvv, + 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 payinfo ); + $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( 'payinfo' => $payinfo ); + $new->set( 'payby' => $p->{'auto'} ? 'CHEK' : 'DCHK' ); + } + $new->set( 'paydate' => $p->{'year'}. '-'. $p->{'month'}. '-01' ); + my $error = $new->replace($cust_main); + return { 'error' => $error } if $error; + $cust_main = $new; + } + + return { 'error' => '' }; + +} + +sub process_payment_order_pkg { + my $p = shift; + + my $hr = process_payment($p); + return $hr if $hr->{'error'}; + + order_pkg($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, + }; + +} + +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 $templatename = $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), + '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, + } + } @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" }; + + #return { 'cust_pkg' => [ map { $_->hashref } $cust_main->ncancelled_pkgs ] }; + + my $conf = new FS::Conf; + + { '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 ) { + push @cust_svc, @{[ $cust_pkg->cust_svc ]}; #@{[ ]} to force array context + } + @cust_svc = grep { $_->part_svc->svcdb eq $p->{'svcdb'} } @cust_svc + if $p->{'svcdb'}; + + #@svc_x = sort { $a->domain cmp $b->domain || $a->username cmp $b->username } + # @svc_x; + + { + #no#'svcnum' => $session->{'svcnum'}, + 'custnum' => $custnum, + 'svcs' => [ map { + my $svc_x = $_->svc_x; + my($label, $value) = $_->label; + my $part_pkg = $svc_x->cust_svc->cust_pkg->part_pkg; + + { 'svcnum' => $_->svcnum, + 'label' => $label, + 'value' => $value, + 'username' => $svc_x->username, + 'email' => $svc_x->email, + 'seconds' => $svc_x->seconds, + 'upbytes' => FS::UI::bytecount::display_bytecount($svc_x->upbytes), + 'downbytes' => FS::UI::bytecount::display_bytecount($svc_x->downbytes), + 'totalbytes'=> FS::UI::bytecount::display_bytecount($svc_x->totalbytes), + 'recharge_amount' => $part_pkg->option('recharge_amount', 1), + 'recharge_seconds' => $part_pkg->option('recharge_seconds', 1), + 'recharge_upbytes' => FS::UI::bytecount::display_bytecount($part_pkg->option('recharge_upbytes', 1)), + 'recharge_downbytes' => FS::UI::bytecount::display_bytecount($part_pkg->option('recharge_downbytes', 1)), + 'recharge_totalbytes' => FS::UI::bytecount::display_bytecount($part_pkg->option('recharge_totalbytes', 1)), + # more... + }; + } + @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 _usage_details { + my ($callback, $p) = (shift,shift); + + 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 $svc_acct = qsearchs ( 'svc_acct', $search ); + return { 'error' => 'No service selected in list_svc_usage' } + unless $svc_acct; + + my $freq = $svc_acct->cust_svc->cust_pkg->part_pkg->freq; + my $start = $svc_acct->cust_svc->cust_pkg->setup; + #my $end = $svc_acct->cust_svc->cust_pkg->bill; # or time? + my $end = time; + + unless($p->{beginning}){ + $p->{beginning} = $svc_acct->cust_svc->cust_pkg->last_bill; + $p->{ending} = $end; + } + + my (@usage) = &$callback($svc_acct,$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, + '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_external' => [ qw( id title ) ], + ); + + 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; + } + + return { error => '', pkgnum => $cust_pkg->pkgnum }; + +} + +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->collect('realtime' => 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 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_acct { + my $p = shift; + + 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'}}); + } + + _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); + + 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 $part_svc = qsearchs('part_svc', { 'svcpart' => $p->{'svcpart'} } ) + or return { 'error' => "unknown svcpart $p->{'svcpart'}" }; + + my $svc_x = $class->new( { + 'pkgnum' => $p->{'pkgnum'}, + 'svcpart' => $p->{'svcpart'}, + map { $_ => $p->{$_} } @$fields + } ); + my $error = $svc_x->insert; + $svc_x = qsearchs($svc_x->table, { 'svcnum' => $svc_x->svcnum }) + unless $error; + + return { 'svc' => $part_svc->svc, + 'error' => $error, + map { $_ => $svc_x->get($_) } @$return_fields + }; + +} + +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 _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 { + return ( 'error' => "Can't resume session" ); #better error message + } + + ($context, $session, $custnum); + +} + +1; + diff --git a/FS/FS/ClientAPI/Signup.pm b/FS/FS/ClientAPI/Signup.pm new file mode 100644 index 000000000..61325b9e1 --- /dev/null +++ b/FS/FS/ClientAPI/Signup.pm @@ -0,0 +1,514 @@ +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::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::acct_snarf; +use FS::queue; +use FS::reg_code; + +$DEBUG = 0; +$me = '[FS::ClientAPI::Signup]'; + +sub signup_info { + my $packet = shift; + + warn "$me signup_info called on $packet\n" if $DEBUG; + + my $conf = new FS::Conf; + + 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 $href = $_->pkgpart_hashref; + $_->agentnum => + [ + map { { 'payby' => [ $_->payby ], + 'freq_pretty' => $_->freq_pretty, + 'options' => { $_->options }, + %{$_->hashref} + } } + grep { $_->svcpart('svc_acct') && $href->{ $_->pkgpart } } + 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; + + $signup_info_cache = { + 'cust_main_county' => [ map $_->hashref, + qsearch('cust_main_county', {} ) + ], + + 'agent' => [ map $_->hashref, + 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'), + + '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')), + + 'default_pkgpart' => scalar($conf->config('signup_server-default_pkgpart')), + + }; + + $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_acct') } + 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_acct') } + 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 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; + + } + # 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'}; + $agent_signup_info; + } else { + $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; + + #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',{} )); + + 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 + ) + + } ); + + return { 'error' => "Illegal payment type" } + unless grep { $_ eq $packet->{'payby'} } + $conf->config('signup_server-payby'); + + $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_acct'); + + 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; + + my $svc_acct = 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_acct->child_objects( \@acct_snarf ); + + my $y = $svc_acct->setdefault; # arguably should be in new method + return { 'error' => $y } if $y && !ref($y); + + #$error = $svc_acct->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_acct ] ); + #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 "[fs_signup_server] Billing customer...\n" if $Debug; + + my $bill_error = $cust_main->bill; + #warn "[fs_signup_server] error billing new customer: $bill_error" + # if $bill_error; + + $bill_error = $cust_main->apply_payments_and_credits; + #warn "[fs_signup_server] error applying payments and credits for". + # " new customer: $bill_error" + # if $bill_error; + + $bill_error = $cust_main->collect('realtime' => 1); + #warn "[fs_signup_server] error collecting from 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; + + return { error => '' }; + +} + +1; diff --git a/FS/FS/ClientAPI/passwd.pm b/FS/FS/ClientAPI/passwd.pm new file mode 100644 index 000000000..b22d7617e --- /dev/null +++ b/FS/FS/ClientAPI/passwd.pm @@ -0,0 +1,46 @@ +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 new file mode 100644 index 000000000..bfab8055d --- /dev/null +++ b/FS/FS/ClientAPI_SessionCache.pm @@ -0,0 +1,78 @@ +package FS::ClientAPI_SessionCache; + +use strict; +use vars qw($module); +use FS::UID qw(datasrc); + +#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, L, L + +=cut + +1; diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm new file mode 100644 index 000000000..a763ed4c6 --- /dev/null +++ b/FS/FS/Conf.pm @@ -0,0 +1,2206 @@ +package FS::Conf; + +use vars qw($base_dir @config_items @base_items @card_types $DEBUG); +use IO::File; +use File::Basename; +use MIME::Base64; +use FS::ConfItem; +use FS::ConfDefaults; +use FS::Conf_compat17; +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 config KEY [ AGENTNUM ] + +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. + +=cut + +sub _usecompat { + my ($self, $method) = (shift, shift); + warn "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)=@_; + 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 (!$cv && defined($agentnum)) { + $hashref->{agentnum} = ''; + $cv = FS::Record::qsearchs('conf', $hashref); + } + return $cv; +} + +sub config { + my $self = shift; + return $self->_usecompat('config', @_) if use_confcompat; + + my($name,$agentnum)=@_; + my $cv = $self->_config($name, $agentnum) 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 ] + +Returns the exact scalar value for key. + +=cut + +sub config_binary { + my $self = shift; + return $self->_usecompat('config_binary', @_) if use_confcompat; + + my($name,$agentnum)=@_; + my $cv = $self->_config($name, $agentnum) or return; + decode_base64($cv->value); +} + +=item exists KEY [ AGENTNUM ] + +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)=@_; + defined($self->_config($name, $agentnum)); +} + +#=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 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}++; + } + } + } + + 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) into +the database as a conf record (see L). 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 eq 'binary') { + $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) 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); + + unless ($type eq 'binary') { + { + 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; + } + } + + if ($type eq 'binary') { + $error .= "$key fails binary comparison; " + unless scalar($self->config_binary($key)) eq scalar($compat->config_binary($key)); + } + + 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. 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' => $_, + 'section' => $proto->section, + 'description' => 'Alternate ' . $proto->description . ' See the billing documentation 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. + +=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 non-deprecated 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_html + invoice_htmlreturnaddress + invoice_htmlfooter + invoice_htmlnotes + logo.png + logo.eps + ); + +@base_items = qw ( + invoice_template + invoice_latex + invoice_latexreturnaddress + invoice_latexfooter + invoice_latexsmallfooter + invoice_latexnotes + invoice_html + invoice_htmlreturnaddress + invoice_htmlfooter + invoice_htmlnotes + logo.png + logo.eps + ); + +@config_items = map { new FS::ConfItem $_ } ( + + { + 'key' => 'address', + 'section' => 'deprecated', + 'description' => 'This configuration option is no longer used. See invoice_template instead.', + 'type' => 'text', + }, + + { + 'key' => 'alerter_template', + 'section' => 'billing', + 'description' => 'Template file for billing method expiration alerts. See the billing documentation for details.', + 'type' => 'textarea', + }, + + { + 'key' => 'apacheip', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add an apache export instead. Used to be the current 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' => 'business-onlinepayment', + 'section' => 'billing', + 'description' => 'Business::OnlinePayment 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 Business::OnlinePayment support for ACH transactions (defaults to regular business-onlinepayment). 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 Business::OnlinePayment. Evaluated as a double-quoted perl string, with the following variables available: $agent (the agent name), and $pkgs (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' => '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' => 'deletecustomers', + 'section' => 'UI', + 'description' => '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 customers\' packages if they cancel service.', + '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' => 'DEPRECATED, 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' => '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:

  • 1: user -> /home/u/user
  • 2: user -> /home/u/s/user
  • -1: user -> /home/r/user
  • -2: user -> home/r/e/user
', + '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 emailinvoiceauto.', + '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' => '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', + }, + + { + 'key' => 'invoice_template', + 'section' => 'billing', + '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 billing documentation for details.', + 'type' => 'textarea', + }, + + { + 'key' => 'invoice_html', + 'section' => 'billing', + 'description' => 'Optional HTML template for invoices. See the billing documentation 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 billing documentation 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_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_sections', + 'section' => 'billing', + 'description' => 'Split invoice into sections and label according to package type when enabled.', + '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 Text::Template documentation for details on the template substitution language. The following variables are available:
  • $date
  • $name
  • $paynum - Freeside payment number
  • $paid - Amount of payment
  • $payby - Payment type (Card, Check, Electronic check, etc.)
  • $payinfo - Masked credit card number or check number
  • $balance - New balance
', + 'type' => [qw( checkbox textarea )], + }, + + { + '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 { $_=>$_ } qw(A CNAME MX NS 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' => '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' => '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: $ip, $nasip and $nasfqdn, 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: $ip, $nasip and $nasfqdn, 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' => 'signupurl', + 'section' => 'UI', + 'description' => 'if you are using customer-to-customer referrals, and you enter the URL of your signup server CGI, 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' => '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 (&) in usernames. Be careful when using this option in conjunction with exports 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. 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' => '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' => '', + 'description' => 'Acceptable payment types for the signup server', + 'type' => 'selectmultiple', + 'select_enum' => [ qw(CARD DCRD CHEK DCHK LECB PREPAY BILL COMP) ], + }, + + { + '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. Make sure to fill in the cancelmessage and cancelsubject configuration values as well.', + '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 Text::Template documentation for details on the template substitution language. The following variables are available
  • $username
  • $password
  • $first
  • $last
  • $pkg
', + 'type' => 'textarea', + 'per_agent' => 1, + }, + + { + 'key' => 'welcome_email-from', + 'section' => '', + 'description' => 'From: address header for welcome email', + 'type' => 'text', + 'per_agent' => 1, + }, + + { + 'key' => 'welcome_email-subject', + 'section' => '', + 'description' => 'Subject: header for welcome email', + 'type' => 'text', + 'per_agent' => 1, + }, + + { + 'key' => 'welcome_email-mimetype', + 'section' => '', + '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 Text::Template documentation and the billing documentation for details on the template substitution language. A variable exists for each fieldname in the customer record ($first, $last, etc). The following additional variables are available
  • $payby - a friendler represenation of the field
  • $payinfo - the masked payment information
  • $expdate - the time at which the payment method expires (a UNIX timestamp)
  • $returnaddress - the invoice return address for this customer\'s agent
', + '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 Text::Template documentation for details on the template substitution language. The following variables are available
  • $username
  • $password
  • $first
  • $last
  • $pkg
  • $column
  • $amount
  • $threshold
', + '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' => 'UI', + 'description' => 'Causes 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' ], + }, + + { + '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' => '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. RT_Internal uses the built-in RT ticketing system (see the integrated ticketing installation instructions). RT_External 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-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, DBI:Pg:user=rt_user;password=rt_word;host=rt.example.com;dbname=rt', + 'type' => 'text', + + }, + + { + 'key' => 'ticket_system-rt_external_url', + 'section' => '', + 'description' => 'With external RT integration, the URL for the external RT installation, for example, https://rt.example.com/rt', + 'type' => 'text', + }, + + { + 'key' => 'company_name', + 'section' => 'required', + 'description' => 'Your company name', + 'type' => 'text', + }, + + { + 'key' => 'company_address', + 'section' => 'required', + 'description' => 'Your company address', + 'type' => 'textarea', + }, + + { + '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' => 'referral_credit', + 'section' => 'billing', + 'description' => "Enables one-time referral credits in the amount of one month referred 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' => '', + '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' => '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', + }, + + { + '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' => 'batch-enable', + 'section' => 'billing', + 'description' => 'Enable credit card and/or ACH batching - leave disabled for real-time installations.', + 'type' => 'checkbox', + }, + + { + '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' => '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-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 Text::Template documentation for details on the template substitition language. Also see packages with a flat price plan The following variables are available
  • $packages allowing $packages->[0] thru $packages->[n]
  • $package the first package, same as $packages->[0]
  • $recurdates allowing $recurdates->[0] thru $recurdates->[n]
  • $recurdate the first recurdate, same as $recurdate->[0]
  • $first
  • $last
', +#
  • $payby
  • $expdate most likely only confuse + 'type' => 'textarea', + }, + + { + 'key' => 'logo.png', + 'section' => 'billing', #? + 'description' => 'An image to include in some types of invoices', + 'type' => 'binary', + }, + + { + 'key' => 'logo.eps', + 'section' => 'billing', #? + 'description' => 'An image to include in some types of invoices', + 'type' => 'binary', + }, + + { + 'key' => 'selfservice-ignore_quantity', + 'section' => '', + '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' => '', + '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' => 'textarea', + }, + + { + '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' => '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' => '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', + ], + }, + +); + +1; diff --git a/FS/FS/ConfDefaults.pm b/FS/FS/ConfDefaults.pm new file mode 100644 index 000000000..79782590d --- /dev/null +++ b/FS/FS/ConfDefaults.pm @@ -0,0 +1,73 @@ +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 address if present)', + 'Cust# | Cust. Status | (bill) Name | (bill) Company | (service) Name | (service) Company' => + 'custnum | Status | Last, First | Company | (same for service address 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 | (all address fields ) | 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 | (all address fields ) | ( 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 | (all address fields ) | ( all phones ) | Invoicing email(s) | Payment Type | Current Balance', + +); } + +=back + +=head1 BUGS + +Not yet. + +=head1 SEE ALSO + +L + +=cut + +1; diff --git a/FS/FS/ConfItem.pm b/FS/FS/ConfItem.pm new file mode 100644 index 000000000..a0e997ac7 --- /dev/null +++ b/FS/FS/ConfItem.pm @@ -0,0 +1,63 @@ +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 + +=cut + +1; + diff --git a/FS/FS/Conf_compat17.pm b/FS/FS/Conf_compat17.pm new file mode 100644 index 000000000..bcd78e8c7 --- /dev/null +++ b/FS/FS/Conf_compat17.pm @@ -0,0 +1,2196 @@ +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. + +=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 billing documentation 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 billing documentation 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 billing documentation 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 billing documentation 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 invoice_template instead.', + 'type' => 'text', + }, + + { + 'key' => 'alerter_template', + 'section' => 'billing', + 'description' => 'Template file for billing method expiration alerts. See the billing documentation for details.', + 'type' => 'textarea', + }, + + { + 'key' => 'apacheroot', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a www_shellcommands export instead. The directory containing Apache virtual hosts', + 'type' => 'text', + }, + + { + 'key' => 'apacheip', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add an apache export instead. Used to be the current IP address to assign to new virtual hosts', + 'type' => 'text', + }, + + { + 'key' => 'apachemachine', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a www_shellcommands export 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' => 'DEPRECATED, add an apache export 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 Include directive.', + 'type' => 'textarea', + }, + + { + 'key' => 'bindprimary', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a bind export 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' => 'DEPRECATED, add a bind_slave export 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' => 'Business::OnlinePayment 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 Business::OnlinePayment support for ACH transactions (defaults to regular business-onlinepayment). 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 Business::OnlinePayment. Evaluated as a double-quoted perl string, with the following variables available: $agent (the agent name), and $pkgs (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' => 'DEPRECATED, add a bsdshell export instead. Your BSD flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd\' and `/etc/master.passwd\'.', + 'type' => 'textarea', + }, + + { + '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' => 'DEPRECATED, add a cyrus export instead. This option used to integrate with Cyrus IMAP Server, 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' => 'DEPRECATED, add a cp export instead. This option used to integrate with Critial Path Account Provisioning Protocol, 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 this 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' => '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' => 'DEPRECATED, 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' => 'DEPRECATED, now controlled by ACLs. Used to enable "unapplication" of unclosed payments.', + 'type' => 'checkbox', + }, + + { + 'key' => 'unapplycredits', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, 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:
    • 1: user -> /home/u/user
    • 2: user -> /home/u/s/user
    • -1: user -> /home/r/user
    • -2: user -> home/r/e/user
    ', + '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 emailinvoiceauto.', + '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' => 'DEPRECATED, 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' => 'DEPRECATED, add an sqlradius export instead. This option used to enable radcheck and radreply table population - by default in the Freeside database, or in the database specified by the icradius_secrets 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.
    ADDITIONAL DEPRECATED FUNCTIONALITY (instead use MySQL replication or point icradius_secrets to the external database) - your ICRADIUS machines or FreeRADIUS (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: "radius.isp.tld radius_db radius_user passw0rd"
    ', + 'type' => [qw( checkbox textarea )], + }, + + { + 'key' => 'icradius_mysqldest', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add an sqlradius export 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' => 'DEPRECATED, add an sqlradius export 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' => 'DEPRECATED, add an sqlradius export 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_template', + 'section' => 'required', + 'description' => 'Required template file for invoices. See the billing documentation for details.', + 'type' => 'textarea', + }, + + { + 'key' => 'invoice_html', + 'section' => 'billing', + 'description' => 'Optional HTML template for invoices. See the billing documentation 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 billing documentation 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_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' => 'DEPRECATED, 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 Text::Template documentation for details on the template substitution language. The following variables are available:
    • $date
    • $name
    • $paynum - Freeside payment number
    • $paid - Amount of payment
    • $payby - Payment type (Card, Check, Electronic check, etc.)
    • $payinfo - Masked credit card number or check number
    • $balance - New balance
    ', + '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' => 'DEPRECATED, 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' => 'DEPRECATED. 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' => 'DEPRECATED, add qmail and shellcommands exports 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 shellmachine option.', + 'type' => [qw( checkbox textarea )], + }, + + { + 'key' => 'radiusmachines', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add an sqlradius export 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' => 'DEPRECATED, add a sendmail export instead. Used to be sendmail configuration file path. Defaults to `/etc\'. Many newer distributions use `/etc/mail\'.', + 'type' => 'text', + }, + + { + 'key' => 'sendmailmachines', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a sendmail export 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' => 'DEPRECATED, add a sendmail export 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: $ip, $nasip and $nasfqdn, 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: $ip, $nasip and $nasfqdn, 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' => 'DEPRECATED, add a shellcommands export 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' => 'DEPRECATED, add a shellcommands export instead. This option used to contain command(s) to run on shellmachine when an account is created. If the shellmachine option is set but this option is not, useradd -d $dir -m -s $shell -u $uid $username is the default. If this option is set but empty, cp -pr /etc/skel $dir; chown -R $uid.$gid $dir is the default instead. Otherwise the value is evaluated as a double-quoted perl string, with the following variables available: $username, $uid, $gid, $dir, and $shell.', + 'type' => [qw( checkbox text )], + }, + + { + 'key' => 'shellmachine-userdel', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a shellcommands export instead. This option used to contain command(s) to run on shellmachine when an account is deleted. If the shellmachine option is set but this option is not, userdel $username is the default. If this option is set but empty, rm -rf $dir is the default instead. Otherwise the value is evaluated as a double-quoted perl string, with the following variables available: $username and $dir.', + 'type' => [qw( checkbox text )], + }, + + { + 'key' => 'shellmachine-usermod', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a shellcommands export instead. This option used to contain command(s) to run on shellmachine when an account is modified. If the shellmachine option is set but this option is empty, [ -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 ) is the default. Otherwise the contents of the file are treated as a double-quoted perl string, with the following variables available: $old_dir, $new_dir, $uid and $gid.', + #'type' => [qw( checkbox text )], + 'type' => 'text', + }, + + { + 'key' => 'shellmachines', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a sysvshell export 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 signup server CGI, 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' => 'DEPRECATED, 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' => 'DEPRECATED, 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 (&) in usernames. Be careful when using this option in conjunction with exports 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' => 'DEPRECATED, add a vpopmail export 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: poptoaster.domain.tld /home/vpopmail 508 508 Note: vpopuid and vpopgid are values taken from the vpopmail machine\'s /etc/passwd', + 'type' => 'textarea', + }, + + { + 'key' => 'vpopmailrestart', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a vpopmail export 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' => 'DEPRECATED, obsolete. Used to validate package definition setup and recur expressions against a preset list. Useful for webdemos, annoying to powerusers.', + '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' => 'DEPRECATED, 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' => 'DEPRECATED, 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' => 'DEPRECATED, 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 Text::Template documentation for details on the template substitution language. The following variables are available
    • $username
    • $password
    • $first
    • $last
    • $pkg
    ', + '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 Text::Template documentation and the billing documentation for details on the template substitution language. A variable exists for each fieldname in the customer record ($first, $last, etc). The following additional variables are available
    • $payby - a friendler represenation of the field
    • $payinfo - the masked payment information
    • $expdate - the time at which the payment method expires (a UNIX timestamp)
    • $returnaddress - the invoice return address for this customer\'s agent
    ', + '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 Text::Template documentation for details on the template substitution language. The following variables are available
    • $username
    • $password
    • $first
    • $last
    • $pkg
    • $column
    • $amount
    • $threshold
    ', + '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' => 'UI', + 'description' => 'Causes 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' ], + }, + + { + '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' => 'DEPRECATED, enable the Complimentary customer access right instead. Was: Usernames (Freeside users, created with freeside-adduser) which can create complimentary customers, one per line. If no usernames are entered, all users can create complimentary accounts.', + 'type' => 'textarea', + }, + + { + '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. RT_Internal uses the built-in RT ticketing system (see the integrated ticketing installation instructions). RT_External 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, DBI:Pg:user=rt_user;password=rt_word;host=rt.example.com;dbname=rt', + 'type' => 'text', + + }, + + { + 'key' => 'ticket_system-rt_external_url', + 'section' => '', + 'description' => 'With external RT integration, the URL for the external RT installation, for example, https://rt.example.com/rt', + 'type' => 'text', + }, + + { + 'key' => 'company_name', + 'section' => 'required', + 'description' => 'Your company name', + 'type' => 'text', + }, + + { + 'key' => 'echeck-void', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, 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' => 'DEPRECATED, 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' => 'DEPRECATED, 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' => 'referral_credit', + 'section' => 'billing', + 'description' => "Enables one-time referral credits in the amount of one month referred 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' => '', + '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' => '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 https://secure.click2callu.com/)', + 'type' => 'text', + }, + { + 'key' => 'vonage-password', + 'section' => '', + 'description' => 'Vonage Click2Call username (see https://secure.click2callu.com/)', + 'type' => 'text', + }, + { + 'key' => 'vonage-fromnumber', + 'section' => '', + 'description' => 'Vonage Click2Call number (see https://secure.click2callu.com/)', + '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' => 'batch-enable', + 'section' => 'billing', + 'description' => 'Enable credit card and/or ACH batching - leave disabled for real-time installations.', + 'type' => 'checkbox', + }, + + { + '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 Text::Template documentation for details on the template substitition language. Also see packages with a flat price plan The following variables are available
    • $packages allowing $packages->[0] thru $packages->[n]
    • $package the first package, same as $packages->[0]
    • $recurdates allowing $recurdates->[0] thru $recurdates->[n]
    • $recurdate the first recurdate, same as $recurdate->[0]
    • $first
    • $last
    ', +#
  • $payby
  • $expdate most likely only confuse + 'type' => 'textarea', + }, + + { + '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' => '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 : ''; + }, + }, + +); + +1; + diff --git a/FS/FS/Cron/backup.pm b/FS/FS/Cron/backup.pm new file mode 100644 index 000000000..204069a12 --- /dev/null +++ b/FS/FS/Cron/backup.pm @@ -0,0 +1,43 @@ +package FS::Cron::backup; + +use strict; +use vars qw( @ISA @EXPORT_OK ); +use Exporter; +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 ) { + 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); + unlink "/var/tmp/$database.gpg" or die $!; + } else { + chmod 0600, '/var/tmp/$database.sql'; + scp("/var/tmp/$database.sql", $dest); + } + unlink "/var/tmp/$database.sql" or die $!; + } +} + +1; diff --git a/FS/FS/Cron/bill.pm b/FS/FS/Cron/bill.pm new file mode 100644 index 000000000..7de2ff2f6 --- /dev/null +++ b/FS/FS/Cron/bill.pm @@ -0,0 +1,150 @@ +package FS::Cron::bill; + +use strict; +use vars qw( @ISA @EXPORT_OK ); +use Exporter; +use Date::Parse; +use FS::UID qw(dbh); +use FS::Record qw(qsearchs); +use FS::cust_main; +use FS::part_event; +use FS::part_event_condition; + +@ISA = qw( Exporter ); +@EXPORT_OK = qw ( bill ); + +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 @search = (); + + push @search, "cust_main.payby = '". $opt{'p'}. "'" + if $opt{'p'}; + push @search, "cust_main.agentnum = ". $opt{'a'} + if $opt{'a'}; + + if ( @ARGV ) { + push @search, "( ". + join(' OR ', map "cust_main.custnum = $_", @ARGV ). + " )"; + } + + ### + # generate where_pkg/where_event search clause + ### + + #we're at now now (and later). + my($time)= $opt{'d'} ? str2time($opt{'d'}) : $^T; + $time += $opt{'y'} * 86400 if $opt{'y'}; + + my $invoice_time = $opt{'n'} ? $^T : $time; + + # select * from cust_main where + my $where_pkg = <<"END"; + 0 < ( select count(*) from cust_pkg + where cust_main.custnum = cust_pkg.custnum + and ( cancel is null or cancel = 0 ) + and ( setup is null or setup = 0 + or bill is null or bill <= $time + or ( expire is not null and expire <= $^T ) + or ( adjourn is not null and adjourn <= $^T ) + ) + ) +END + + 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, + ); + + my $are_part_event = + "0 < ( SELECT COUNT(*) FROM part_event $join + WHERE check_freq = '$check_freq' + AND eventtable = '$eventtable' + AND ( disabled = '' OR disabled IS NULL ) + AND $where + ) + "; + + if ( $eventtable eq 'cust_main' ) { + $are_part_event; + } else { + "0 < ( SELECT COUNT(*) FROM $eventtable + WHERE cust_main.custnum = $eventtable.custnum + AND $are_part_event + ) + "; + } + + } FS::part_event->eventtables); + + push @search, "( $where_pkg OR $where_event )"; + + ### + # get a list of custnums + ### + + warn "searching for customers:\n". join("\n", @search). "\n" + if $opt{'v'} || $opt{'l'}; + + my $sth = dbh->prepare( + "SELECT custnum FROM cust_main". + " WHERE ". join(' AND ', @search) + ) or die dbh->errstr; + + $sth->execute or die $sth->errstr; + + my @custnums = map { $_->[0] } @{ $sth->fetchall_arrayref }; + + ### + # 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 ) { + + if ( $opt{'m'} ) { + + #add job to queue that calls bill_and_collect with options + my $queue = new FS::queue { + 'job' => 'FS::cust_main::queued_bill', + 'secure' => 'Y', + }; + my $error = $queue->insert( + 'custnum' => $custnum, + 'time' => $time, + 'invoice_time' => $invoice_time, + 'check_freq' => $check_freq, + 'resetup' => $opt{'s'} ? $opt{'s'} : 0, + ); + + } else { + + my $cust_main = qsearchs( 'cust_main', { 'custnum' => $custnum } ); + + $cust_main->bill_and_collect( + 'time' => $time, + 'invoice_time' => $invoice_time, + 'check_freq' => $check_freq, + 'resetup' => $opt{'s'}, + 'debug' => $debug, + ); + + } + + } + +} diff --git a/FS/FS/Cron/expire_user_pref.pm b/FS/FS/Cron/expire_user_pref.pm new file mode 100644 index 000000000..32269271e --- /dev/null +++ b/FS/FS/Cron/expire_user_pref.pm @@ -0,0 +1,20 @@ +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 new file mode 100644 index 000000000..23cf920b2 --- /dev/null +++ b/FS/FS/Cron/notify.pm @@ -0,0 +1,149 @@ +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); +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 $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 part_pkg_option.optionvalue > 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 cust_pkg_option.optionvalue = 1 + ) +END + + if ($opt{a}) { + $where_pkg .= <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 $error = + $cust_main->notify( 'impending_recur_template', + 'extra_fields' => { 'packages' => \@packages, + 'recurdates' => \@recurdates, + 'package' => $packages[0], + 'recurdate' => $recurdates[0], + }, + ); + 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/vacuum.pm b/FS/FS/Cron/vacuum.pm new file mode 100644 index 000000000..075572d50 --- /dev/null +++ b/FS/FS/Cron/vacuum.pm @@ -0,0 +1,23 @@ +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 new file mode 100644 index 000000000..bcd337d2c --- /dev/null +++ b/FS/FS/CurrentUser.pm @@ -0,0 +1,67 @@ +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 new file mode 100644 index 000000000..7e0d45c20 --- /dev/null +++ b/FS/FS/Daemon.pm @@ -0,0 +1,92 @@ +package FS::Daemon; + +use vars qw( @ISA @EXPORT_OK ); +use vars qw( $pid_dir $me $pid_file $sigint $sigterm $logfile ); +use Exporter; +use Fcntl qw(:flock); +use POSIX qw(setsid); +use IO::File; +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 sigint sigterm logfile ); + +$pid_dir = '/var/run'; + +sub daemonize1 { + $me = shift; + + $pid_file = "$pid_dir/$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; + print $pidfh "$pid\n"; + exit; + } + + #sub REAPER { my $pid = wait; $SIG{CHLD} = \&REAPER; $kids--; } + #$SIG{CHLD} = \&REAPER; + $sigterm = 0; + $sigint = 0; + $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 _die { + my $msg = shift; + unlink $pid_file if -e $pid_file; + _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; +} + diff --git a/FS/FS/InitHandler.pm b/FS/FS/InitHandler.pm new file mode 100644 index 000000000..5038cf352 --- /dev/null +++ b/FS/FS/InitHandler.pm @@ -0,0 +1,91 @@ +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 () { + 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/Misc.pm b/FS/FS/Misc.pm new file mode 100644 index 000000000..54467a1fb --- /dev/null +++ b/FS/FS/Misc.pm @@ -0,0 +1,576 @@ +package FS::Misc; + +use strict; +use vars qw ( @ISA @EXPORT_OK $DEBUG ); +use Exporter; +use Carp; +use Data::Dumper; +#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 send_fax + states_hash counties state_label + card_types + generate_ps do_print + ); + +$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 elimiate code duplication. + +=head1 SUBROUTINES + +=over 4 + +=item send_email OPTION => VALUE ... + +Options: + +I - (required) + +I - (required) comma-separated scalar or arrayref of recipients + +I - (required) + +I - (optional) MIME type for the body + +I - (required unless I is true) arrayref of body text lines + +I - (optional, but required if I is true) arrayref of MIME::Entity->build PARAMHASH refs or MIME::Entity objects. These will be passed as arguments to MIME::Entity->attach(). + +I - (optional) when set true, send_email will ignore the I option and simply construct a message with the given I. In this case, +I, if specified, overrides the default "multipart/mixed" for the outermost MIME container. + +I - (optional) when using nobody, optional top-level MIME +encoding which, if specified, overrides the default "7bit". + +I - (optional) type parameter for multipart/related messages + +=cut + +use vars qw( $conf ); +use Date::Format; +use Mail::Header; +use Mail::Internet 2.00; +use MIME::Entity; +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" + } + + $ENV{MAILADDRESS} = $options{'from'}; + my $to = ref($options{to}) ? join(', ', @{ $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 @example.com'; + $domain = 'example.com'; + } + my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain"; + + my $message = MIME::Entity->build( + 'From' => $options{'from'}, + 'To' => $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!"; + } + + } + + my $smtpmachine = $conf->config('smtpmachine'); + $!=0; + + $message->mysmtpsend( 'Host' => $smtpmachine, + 'MailFrom' => $options{'from'}, + ); + +} + +#this kludges a "mysmtpsend" method into Mail::Internet for send_email above +#now updated for MailTools v2! +package Mail::Internet; + +use Mail::Address; +use Net::SMTP; +use Net::Domain; + +sub Mail::Internet::mysmtpsend($@) { + my ($self, %opt) = @_; + + my $host = $opt{Host}; + my $envelope = $opt{MailFrom}; # || mailaddress(); + my $quit = 1; + + my ($smtp, @hello); + + push @hello, Hello => $opt{Hello} + if defined $opt{Hello}; + + push @hello, Port => $opt{Port} + if exists $opt{Port}; + + push @hello, Debug => $opt{Debug} + if exists $opt{Debug}; + +# if(!defined $host) +# { local $SIG{__DIE__}; +# my @hosts = qw(mailhost localhost); +# unshift @hosts, split /\:/, $ENV{SMTPHOSTS} +# if defined $ENV{SMTPHOSTS}; +# +# foreach $host (@hosts) +# { $smtp = eval { Net::SMTP->new($host, @hello) }; +# last if defined $smtp; +# } +# } +# elsif(ref($host) && UNIVERSAL::isa($host,'Net::SMTP')) + if(ref($host) && UNIVERSAL::isa($host,'Net::SMTP')) + { $smtp = $host; + $quit = 0; + } + else + { #local $SIG{__DIE__}; + #$smtp = eval { Net::SMTP->new($host, @hello) }; + $smtp = Net::SMTP->new($host, @hello); + } + + unless ( defined($smtp) ) { + my $err = $!; + $err =~ s/Invalid argument/Unknown host/; + return "can't connect to $host: $err" + } + + my $head = $self->cleaned_header_dup; + + $head->delete('Bcc'); + + # Who is it to + + my @rcpt = map { ref $_ ? @$_ : $_ } grep { defined } @opt{'To','Cc','Bcc'}; + @rcpt = map { $head->get($_) } qw(To Cc Bcc) + unless @rcpt; + + my @addr = map {$_->address} Mail::Address->parse(@rcpt); + #@addr or return (); + return 'No valid destination addresses found!' + unless(@addr); + + # Send it + + my $ok = $smtp->mail($envelope) + && $smtp->to(@addr) + && $smtp->data(join("", @{$head->header}, "\n", @{$self->body})); + + #$quit && $smtp->quit; + #$ok ? @addr : (); + if ( $ok ) { + $quit && $smtp->quit; + return ''; + } else { + return $smtp->code. ' '. $smtp->message; + } +} +package FS::Misc; +#eokludge + +=item send_fax OPTION => VALUE ... + +Options: + +I - (required) 10-digit phone number w/ area code + +I - (required) Array ref containing PostScript or TIFF Class F document + +-or- + +I - (required) Filename of PostScript TIFF Class F document + +...any other options will be passed to L + + +=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 ) = @_; + + sort map { s/[\n\r]//g; $_; } + map { $_->county } + qsearch({ + 'select' => 'DISTINCT county', + 'table' => 'cust_main_county', + 'hashref' => { '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). + +=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 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); + + my $sfile = shell_quote $file; + + system("pslatex $sfile.tex >/dev/null 2>&1") == 0 + or die "pslatex $file.tex failed; see $file.log for details?\n"; + system("pslatex $sfile.tex >/dev/null 2>&1") == 0 + or die "pslatex $file.tex failed; see $file.log for details?\n"; + + 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 () { + $ps .= $_; + } + + close POSTSCRIPT; + + if ( $conf->exists('lpr-postscript_suffix') ) { + my $suffix = $conf->config('lpr-postscript_suffix'); + $ps .= eval qq("$suffix"); + } + + return $ps; + +} + +=item print ARRAYREF + +Sends the lines in ARRAYREF to the printer. + +=cut + +use IPC::Run3; + +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"; + } + +} + +=back + +=head1 BUGS + +This package exists. + +=head1 SEE ALSO + +L, L, L, the base documentation. + +L + +=cut + +1; diff --git a/FS/FS/Misc/prune.pm b/FS/FS/Misc/prune.pm new file mode 100644 index 000000000..371f31cbb --- /dev/null +++ b/FS/FS/Misc/prune.pm @@ -0,0 +1,126 @@ +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(); + +=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, L, and L). +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 = < { 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 new file mode 100644 index 000000000..625743dc0 --- /dev/null +++ b/FS/FS/Msgcat.pm @@ -0,0 +1,98 @@ +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; +use FS::msgcat; + +@ISA = qw(Exporter); +@EXPORT_OK = qw( gettext geterror ); + +$FS::UID::callback{'Msgcat'} = sub { + $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 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, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/Pony.pm b/FS/FS/Pony.pm new file mode 100644 index 000000000..c37dd7855 --- /dev/null +++ b/FS/FS/Pony.pm @@ -0,0 +1,23 @@ +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 new file mode 100644 index 000000000..db940034d --- /dev/null +++ b/FS/FS/Record.pm @@ -0,0 +1,2351 @@ +package FS::Record; + +use strict; +use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG + $conf $me + %virtual_fields_cache $nowarn_identical $no_update_diff ); +use Exporter; +use Carp qw(carp cluck croak confess); +use File::CounterFile; +use Locale::Country; +use DBI qw(:sql_types); +use DBIx::DBSchema 0.33; +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; + +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); + +$DEBUG = 0; +$me = '[FS::Record]'; + +$nowarn_identical = 0; +$no_update_diff = 0; + +my $rsa_module; +my $rsa_loaded; +my $rsa_encrypt; +my $rsa_decrypt; + +FS::UID->install_callback( sub { + $conf = new FS::Conf; + $File::CounterFile::DEFAULT_DIR = $conf->base_dir . "/counters.". datasrc; +} ); + + +=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 +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'}; + } + + $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: + + my @records = qsearch( { + 'table' => 'table_name', + 'hashref' => { 'field' => 'value' + 'field' => { 'op' => '<', + 'value' => '420', + }, + }, + + #these are optional... + 'select' => '*', + 'extra_sql' => 'AND field ', + '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' } ); + +###oops, argh, FS::Record::new only lets us create database fields. +#Normal behaviour if SELECT is not specified is `*', as in +#C!; + $county_html .= ''; + } else { + $county_html .= + qq!!; + } + + my $state_html = qq!'; + + $state_html .= ''; + + my $country_html = qq!'; + + ($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, L, L, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/FS/cust_main_invoice.pm b/FS/FS/cust_main_invoice.pm new file mode 100644 index 000000000..71029d096 --- /dev/null +++ b/FS/FS/cust_main_invoice.pm @@ -0,0 +1,173 @@ +package FS::cust_main_invoice; + +use strict; +use vars qw(@ISA $conf); +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) + +=item dest - Invoice destination: If numeric, a svcnum (see L), 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 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 configuration file, it will change the +#invoice destination from an email address to a service number (see +#L). + +=cut + +sub checkdest { + my $self = shift; + + my $error = $self->ut_text('dest'); + return $error if $error; + + 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 ( $self->dest =~ /^([\w\.\-\&\+]+)\@(([\w\.\-]+\.)+\w+)$/ ) { + 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; + } +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, L + +=cut + +1; + diff --git a/FS/FS/cust_main_note.pm b/FS/FS/cust_main_note.pm new file mode 100644 index 000000000..4732d12ce --- /dev/null +++ b/FS/FS/cust_main_note.pm @@ -0,0 +1,131 @@ +package FS::cust_main_note; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs ); + +@ISA = qw(FS::Record); + +=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 _date - + +=item otaker - + +=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 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_numbern('_date') + || $self->ut_text('otaker') + || $self->ut_anything('comments') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +Lurking in the cracks. + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm new file mode 100644 index 000000000..90a14ea02 --- /dev/null +++ b/FS/FS/cust_pay.pm @@ -0,0 +1,882 @@ +package FS::cust_pay; + +use strict; +use vars qw( @ISA $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::payby; +use FS::cust_main_Mixin; +use FS::payinfo_Mixin; +use FS::cust_bill; +use FS::cust_bill_pay; +use FS::cust_pay_refund; +use FS::cust_main; +use FS::cust_pay_void; + +@ISA = qw(FS::Record FS::cust_main_Mixin FS::payinfo_Mixin ); + +$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) + +=item _date - specified as a UNIX timestamp; see L. Also see +L and L for conversion functions. + +=item paid - Amount of this payment + +=item otaker - order taker (assigned automatically, see L) + +=item payby - Payment Type (See L for valid payby values) + +=item payinfo - Payment Information (See L for data format) + +=item paymask - Masked payinfo (See L 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' + +=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 + +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. An 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 $self: $error"; + } + + 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; + 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 + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + #my $cust_main = $self->cust_main; + if ( $conf->exists('payment_receipt_email') + && grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list + ) { + + $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though? + + my $error; + if ( ( exists($options{'manual'}) && $options{'manual'} ) + || ! $conf->exists('invoice_html_statement') + || ! $cust_bill + ) { + + 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 @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } + $cust_main->invoicing_list; + + my $payby = $self->payby; + my $payinfo = $self->payinfo; + $payby =~ s/^BILL$/Check/ if $payinfo; + $payinfo = $self->paymask if $payby eq 'CARD' || $payby eq 'CHEK'; + $payby =~ s/^CHEK$/Electronic check/; + + $error = send_email( + 'from' => $conf->config('invoice_from'), #??? well as good as any + 'to' => \@invoicing_list, + 'subject' => 'Payment receipt', + 'body' => [ $receipt_template->fill_in( HASH => { + '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, + } ) ], + ); + + } else { + + my $queue = new FS::queue { + 'paynum' => $self->paynum, + 'job' => 'FS::cust_bill::queueable_email', + }; + $error = $queue->insert( + 'invnum' => $cust_bill->invnum, + 'template' => 'statement', + ); + + } + + if ( $error ) { + warn "can't send payment receipt/statement: $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 and L). 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->config('deletepayments') ne '' ) { + + my $cust_main = $self->cust_main; + + my $error = send_email( + 'from' => $conf->config('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... + +=cut + +sub replace { + #return "Can't modify payment!" + 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->otaker(getotaker) unless ($self->otaker); + + my $error = + $self->ut_numbern('paynum') + || $self->ut_numbern('custnum') + || $self->ut_numbern('_date') + || $self->ut_money('paid') + || $self->ut_alpha('otaker') + || $self->ut_textn('paybatch') + || $self->ut_textn('payunique') + || $self->ut_enum('closed', [ '', 'Y' ]) + || $self->payinfo_check() + ; + 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; + +#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->otaker(getotaker); + + $self->SUPER::check; +} + +=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 cust_bill_pay + +Returns all applications to invoices (see L) for this +payment. + +=cut + +sub cust_bill_pay { + my $self = shift; + 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) to this +payment. + +=cut + +sub cust_pay_refund { + my $self = shift; + 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) and refund +applications (see L). + +=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). + +=cut + +sub unrefunded { + my $self = shift; + my $amount = $self->paid; + $amount -= $_->amount foreach ( $self->cust_pay_refund ); + sprintf("%.2f", $amount ); +} + + +=item cust_main + +Returns the parent customer object (see L). + +=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; + 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 CLASS METHODS + +=over 4 + +=item unapplied_sql + +Returns an SQL fragment to retreive the unapplied amount. + +=cut + +sub unapplied_sql { + #my $class = shift; + + "paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,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; + + #not the most efficient, but hey, it only has to run once + + my $count_sql = + "SELECT COUNT(*) FROM cust_pay WHERE otaker IS NULL OR otaker = ''"; + + my $sth = dbh->prepare($count_sql) or die dbh->errstr; + $sth->execute or die $sth->errstr; + my $total = $sth->fetchrow_arrayref->[0]; + + local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info + + my $count = 0; + my $lastprog = 0; + while (1) { + + my $cust_pay = qsearchs( { + 'table' => 'cust_pay', + 'hashref' => {}, + 'extra_sql' => "WHERE otaker IS NULL OR otaker = ''", + 'order_by' => 'ORDER BY paynum LIMIT 1', + } ); + + return unless $cust_pay; + + my $h_cust_pay = $cust_pay->h_search('insert'); + if ( $h_cust_pay ) { + $cust_pay->otaker($h_cust_pay->history_user); + } else { + $cust_pay->otaker('legacy'); + } + + delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge + my $error = $cust_pay->replace; + die $error if $error; + $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; + } + + } + +} + +=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, L, L, L, +schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_pay_batch.pm b/FS/FS/cust_pay_batch.pm new file mode 100644 index 000000000..9ef1e1cc1 --- /dev/null +++ b/FS/FS/cust_pay_batch.pm @@ -0,0 +1,277 @@ +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 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) 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) 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"; + } + ''; +} + +=back + +=head1 BUGS + +There should probably be a configuration file with a list of allowed credit +card types. + +=head1 SEE ALSO + +L, L + +=cut + +1; + diff --git a/FS/FS/cust_pay_pending.pm b/FS/FS/cust_pay_pending.pm new file mode 100644 index 000000000..ad39b10d7 --- /dev/null +++ b/FS/FS/cust_pay_pending.pm @@ -0,0 +1,229 @@ +package FS::cust_pay_pending; + +use strict; +use vars qw( @ISA @encrypted_fields ); +use FS::Record qw( qsearch qsearchs ); +use FS::payby; +use FS::payinfo_Mixin; +use FS::cust_main; +use FS::cust_pay; + +@ISA = qw(FS::Record FS::payinfo_Mixin); + +@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) + +=item paid + +Amount of this payment + +=item _date + +Specified as a UNIX timestamp; see L. Also see +L and L for conversion functions. + +=item payby + +Payment Type (See L for valid payby values) + +=item payinfo + +Payment Information (See L for data format) + +=item paymask + +Masked payinfo (See L for how this works) + +=item paydate + +Expiration date + +=item payunique + +Unique identifer to prevent duplicate transactions. + +=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. + +=cut + +#=item cust_balance - + +=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 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_foreign_keyn('paynum', 'cust_pay', 'paynum' ) + || $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; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_pay_refund.pm b/FS/FS/cust_pay_refund.pm new file mode 100644 index 000000000..cb9dbcef2 --- /dev/null +++ b/FS/FS/cust_pay_refund.pm @@ -0,0 +1,188 @@ +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) to an payment (see L). 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) + +=item amount - amount of the credit applied + +=item _date - specified as a UNIX timestamp; see L. Also see +L and L 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) + +=cut + +sub cust_pay { + my $self = shift; + qsearchs( 'cust_pay', { 'paynum' => $self->paynum } ); +} + +=item cust_refund + +Returns the refund (see L) + +=cut + +sub cust_refund { + my $self = shift; + qsearchs( 'cust_refund', { 'refundnum' => $self->refundnum } ); +} + +=back + +=head1 BUGS + +The delete method. + +=head1 SEE ALSO + +L, L, L, L, +schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_pay_void.pm b/FS/FS/cust_pay_void.pm new file mode 100644 index 000000000..de05f710b --- /dev/null +++ b/FS/FS/cust_pay_void.pm @@ -0,0 +1,225 @@ +package FS::cust_pay_void; +use strict; +use vars qw( @ISA @encrypted_fields ); +use Business::CreditCard; +use FS::UID qw(getotaker); +use FS::Record qw(qsearchs dbh fields); # qsearch ); +use FS::cust_pay; +#use FS::cust_bill; +#use FS::cust_bill_pay; +#use FS::cust_pay_refund; +#use FS::cust_main; + +@ISA = qw( FS::Record FS::payinfo_Mixin ); + +@encrypted_fields = ('payinfo'); + +=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) + +=item paid - Amount of this payment + +=item _date - specified as a UNIX timestamp; see L. Also see +L and L for conversion functions. + +=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 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 method to add the original payment back. + +=item replace OLD_RECORD + +Currently unimplemented. + +=cut + +sub replace { + return "Can't modify voided payments!"; +} + +=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_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->otaker(getotaker); + + $self->SUPER::check; +} + +=item cust_main + +Returns the parent customer object (see L). + +=cut + +sub cust_main { + my $self = shift; + qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); +} + +=back + +=head1 BUGS + +Delete and replace methods. + +=head1 SEE ALSO + +L, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm new file mode 100644 index 000000000..d41359634 --- /dev/null +++ b/FS/FS/cust_pkg.pm @@ -0,0 +1,2091 @@ +package FS::cust_pkg; + +use strict; +use vars qw(@ISA $disable_agentcheck $DEBUG); +use List::Util qw(max); +use Tie::IxHash; +use FS::UID qw( getotaker dbh ); +use FS::Misc qw( send_email ); +use FS::Record qw( qsearch qsearchs ); +use FS::m2m_Common; +use FS::cust_main_Mixin; +use FS::cust_svc; +use FS::part_pkg; +use FS::cust_main; +use FS::type_pkgs; +use FS::pkg_svc; +use FS::cust_bill_pkg; +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::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; + +@ISA = qw( FS::m2m_Common FS::cust_main_Mixin FS::option_Common FS::Record ); + +$DEBUG = 0; + +$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) + +=item pkgpart - Billing item definition (see L) + +=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 cancel - date + +=item otaker - order taker (assigned automatically if null, see L) + +=item manual_flag - If this field is set to 1, disables the automatic +unsuspension of this package when using the B config file. + +=back + +Note: setup, bill, adjourn, susp, expire and cancel are specified as UNIX timestamps; +see L. Also see L and L 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 is defined instead of I, it +will be used to look up the package definition and agent restrictions will be +ignored. + +If the additional field I is defined, an FS::pkg_referral record will +be created and inserted. Multiple FS::pkg_referral records can be created by +setting I to an array reference of refnums or a hash reference with +refnums as keys. If no I is defined, a default FS::pkg_referral +record will be created corresponding to cust_main.refnum. + +The following options are available: I + +I, if set true, supresses any referral credit to a referring customer. + +=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; + } + + $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->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; + my $cust_main = $self->cust_main; + my $part_pkg = $self->part_pkg; + if ( $conf->exists('referral_credit') + && $cust_main->referral_custnum + && ! $options{'change'} + && $part_pkg->freq !~ /^0\D?$/ + ) + { + my $referring_cust_main = $cust_main->referring_cust_main; + if ( $referring_cust_main->status ne 'cancelled' ) { + my $error; + if ( $part_pkg->freq !~ /^\d+$/ ) { + warn 'WARNING: Not crediting customer '. $cust_main->referral_custnum. + ' for package '. $self->pkgnum. + ' ( customer '. $self->custnum. ')'. + ' - One-time referral credits not (yet) available for '. + ' packages with '. $part_pkg->freq_pretty. ' frequency'; + } else { + + my $amount = sprintf( "%.2f", $part_pkg->base_recur / $part_pkg->freq ); + my $error = + $referring_cust_main-> + credit( $amount, + 'Referral credit for '.$cust_main->name, + 'reason_type' => $conf->config('referral_credit_type') + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error crediting customer ". $cust_main->referral_custnum. + " for referral: $error"; + } + + } + + } + } + + 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 + +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). + +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). + +Calls + +=cut + +sub replace { + my( $new, $old, %options ) = @_; + + # We absolutely have to have an old vs. new record to make this work. + if (!defined($old)) { + $old = qsearchs( 'cust_pkg', { 'pkgnum' => $new->pkgnum } ); + } + #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart; + return "Can't change otaker!" if $old->otaker ne $new->otaker; + + #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, + ); + 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; + + my $error = + $self->ut_numbern('pkgnum') + || $self->ut_foreign_key('custnum', 'cust_main', 'custnum') + || $self->ut_numbern('pkgpart') + || $self->ut_numbern('setup') + || $self->ut_numbern('bill') + || $self->ut_numbern('susp') + || $self->ut_numbern('cancel') + || $self->ut_numbern('adjourn') + || $self->ut_numbern('expire') + ; + 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 } ); + my $pkgpart_href = $agent->pkgpart_hashref; + return "agent ". $agent->agentnum. + " can't purchase pkgpart ". $self->pkgpart + unless $pkgpart_href->{ $self->pkgpart }; + } + + $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' ); + return $error if $error; + + } + + $self->otaker(getotaker) unless $self->otaker; + $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker"; + $self->otaker($1); + + 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 and L) +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), 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, reason - Text of the new reason. + +=back + +If there is an error, returns the error, otherwise returns false. + +=cut + +sub cancel { + my( $self, %options ) = @_; + + 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 $cancel_time = $options{'time'} || time; + + my $error; + + if ( $options{'reason'} ) { + $error = $self->insert_reason( 'reason' => $options{'reason'} ); + if ( $error ) { + dbh->rollback if $oldAutoCommit; + return "Error inserting cust_pkg_reason: $error"; + } + } + + my %svc; + 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"; + } + } + + unless ( $self->getfield('cancel') ) { + # Add a credit for remaining service + my $remaining_value = $self->calc_remain(time=>$cancel_time); + if ( $remaining_value > 0 && !$options{'no_credit'} ) { + my $conf = new FS::Conf; + 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"; + } + } + my %hash = $self->hash; + $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; + + my $conf = new FS::Conf; + my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list; + if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) { + my $conf = new FS::Conf; + my $error = send_email( + 'from' => $conf->config('invoice_from'), + '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 suspend [ OPTION => VALUE ... ] + +Suspends all services (see L and L) 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), 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, reason - Text of the new reason. + +=back + +If there is an error, returns the error, otherwise returns false. + +=cut + +sub suspend { + 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; + + if ( $options{'reason'} ) { + $error = $self->insert_reason( 'reason' => $options{'reason'} ); + if ( $error ) { + dbh->rollback if $oldAutoCommit; + return "Error inserting cust_pkg_reason: $error"; + } + } + + 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; + } + } + + } + + unless ( $self->getfield('susp') ) { + my %hash = $self->hash; + $hash{'susp'} = 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 and L) 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: I. + +I 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? + +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; + + 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; + } + } + + } + + unless ( ! $self->getfield('susp') ) { + my %hash = $self->hash; + my $inactive = time - $hash{'susp'}; + + my $conf = new FS::Conf; + + $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive + if ( $opt{'adjust_next_bill'} + || $conf->config('unsuspend-always_adjust_next_bill_date') ) + && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} ); + + $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 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; + if ( $self->dbdef_table->column('last_bill') ) { + 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_reason + +Returns the most recent FS::reason associated with the package. + +=cut + +sub last_reason { + my $self = shift; + my $cust_pkg_reason = qsearchs( { + 'table' => 'cust_pkg_reason', + 'hashref' => { 'pkgnum' => $self->pkgnum, }, + 'extra_sql'=> 'ORDER BY date DESC LIMIT 1', + } ); + qsearchs ( 'reason', { 'reasonnum' => $cust_pkg_reason->reasonnum } ) + if $cust_pkg_reason; +} + +=item part_pkg + +Returns the definition for this billing item, as an FS::part_pkg object (see +L). + +=cut + +sub part_pkg { + my $self = shift; + #exists( $self->{'_pkgpart'} ) + $self->{'_pkgpart'} + ? $self->{'_pkgpart'} + : 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 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 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 calc_remain + +Calls the I 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 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). + +=cut + +sub cust_bill_pkg { + my $self = shift; + qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } ); +} + +=item cust_event + +Returns the new-style customer billing events (see L) 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) 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). If a svcpart is specified, return only the matching +services. + +=cut + +sub cust_svc { + my $self = shift; + + if ( @_ ) { + return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum, + 'svcpart' => shift, } ); + } + + #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). If a svcpart +is specified, return only the matching services. + +=cut + +sub overlimit { + my $self = shift; + grep { $_->overlimit } $self->cust_svc; +} + +=item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] + +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). + +=cut + +sub h_cust_svc { + my $self = shift; + + $self->_sort_cust_svc( + [ qsearch( 'h_cust_svc', + { 'pkgnum' => $self->pkgnum, }, + FS::h_cust_svc->sql_h_search(@_), + ) + ] + ); +} + +sub _sort_cust_svc { + my( $self, $arrayref ) = @_; + + map { $_->[0] } + sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] } + 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; + 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, 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); + $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'} = [ $self->cust_svc($part_svc->svcpart) ]; + $part_svc; + } $self->part_pkg->pkg_svc; + + #extras + push @part_svc, map { + my $part_svc = $_; + my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart); + $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail + $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ? + $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ]; + $part_svc; + } $self->extra_part_svc; + + @part_svc; + +} + +=item extra_part_svc + +Returns a list of FS::part_svc objects corresponding to services in this +package which are still provisioned but not (any longer) available in the +package definition. + +=cut + +sub extra_part_svc { + my $self = shift; + + my $pkgnum = $self->pkgnum; + my $pkgpart = $self->pkgpart; + + qsearch( { + 'table' => 'part_svc', + 'hashref' => {}, + 'extra_sql' => "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc + WHERE pkg_svc.svcpart = part_svc.svcpart + AND pkg_svc.pkgpart = $pkgpart + AND quantity > 0 + ) + AND 0 < ( SELECT count(*) + FROM cust_svc + LEFT JOIN cust_pkg using ( pkgnum ) + WHERE cust_svc.svcpart = part_svc.svcpart + AND pkgnum = $pkgnum + )", + } ); +} + +=item status + +Returns a short status string for this package, currently: + +=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 statuses + +Class method that returns the list of possible status strings for packages +(see L). For example: + + @statuses = FS::cust_pkg->statuses(); + +=cut + +tie my %statuscolor, 'Tie::IxHash', + 'not yet billed' => '000000', + '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 labels + +Returns a list of lists, calling the label method for all services +(see L) of this billing item. + +=cut + +sub labels { + my $self = shift; + map { [ $_->label ] } $self->cust_svc; +} + +=item h_labels END_TIMESTAMP [ START_TIMESTAMP ] + +Like the labels method, but returns historical information on services that +were active as of END_TIMESTAMP and (optionally) not cancelled before +START_TIMESTAMP. + +Returns a list of lists, calling the label method for all (historical) services +(see L) of this billing item. + +=cut + +sub h_labels { + my $self = shift; + map { [ $_->label(@_) ] } $self->h_cust_svc(@_); +} + +=item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ] + +Like h_labels, except returns a simple flat list, and shortens long +(currently >5) 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 { + my $self = shift; + + my %labels; + #tie %labels, 'Tie::IxHash'; + push @{ $labels{$_->[0]} }, $_->[1] + foreach $self->h_labels(@_); + my @labels; + foreach my $label ( keys %labels ) { + my @values = @{ $labels{$label} }; + my $num = scalar(@values); + if ( $num > 5 ) { + push @labels, "$label ($num)"; + } else { + push @labels, map { "$label: $_" } @values; + } + } + + @labels; + +} + +=item cust_main + +Returns the parent customer object (see L). + +=cut + +sub cust_main { + my $self = shift; + qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); +} + +=item seconds_since TIMESTAMP + +Returns the number of seconds all accounts (see L) in this +package have been online since TIMESTAMP, according to the session monitor. + +TIMESTAMP is specified as a UNIX timestamp; see L. Also see +L and L 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) 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. Also see L and L 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) +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. Also see L and L 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 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 (not svcdb), unless the B 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 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; + ''; + +} + +=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 active_sql + +Returns an SQL expression identifying active packages. + +=cut + +sub active_sql { " + ". $_[0]->recurring_sql(). " + 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.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 search_sql HREF + +Returns a qsearch hash expression to search for parameters specified in HREF. +Valid parameters are + +=over 4 +=item agentnum +=item magic - /^(active|inactive|suspended|cancell?ed)$/ +=item status - /^(active|inactive|suspended|one-time charge|inactive|cancell?ed)$/ +=item classnum +=item pkgpart - list specified how? +=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/APKG_pkgnum)$/ +=item cust_fields - a value suited to passing to FS::UI::Web::cust_header +=item CurrentUser - specifies the user for agent virtualization +=back + +=cut + +sub search_sql { + my ($class, $params) = @_; + my @where = (); + + ## + # parse agent + ## + + if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) { + push @where, + "cust_main.agentnum = $1"; + } + + ## + # parse status + ## + + if ( $params->{'magic'} eq 'active' + || $params->{'status'} eq 'active' ) { + + push @where, FS::cust_pkg->active_sql(); + + } elsif ( $params->{'magic'} eq 'inactive' + || $params->{'status'} eq '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(); + + } elsif ( $params->{'status'} =~ /^(one-time charge|inactive)$/ ) { + + push @where, FS::cust_pkg->inactive_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, "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, "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 part_pkg + ### + + my $pkgpart = join (' OR pkgpart=', + grep {$_} map { /^(\d+)$/; } ($params->{'pkgpart'})); + push @where, '(pkgpart=' . $pkgpart . ')' if $pkgpart; + + ### + # 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' => {}, + '' => {}, + ); + + foreach my $field (qw( setup last_bill bill adjourn susp expire 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 USING ( 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, + }; + +} + +=head1 SUBROUTINES + +=over 4 + +=item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ] + +CUSTNUM is a customer (see L) + +PKGPARTS is a list of pkgparts specifying the the billing item definitions (see +L) 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) are moved to the +new billing items. An error is returned if this is not possible (see +L). 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 to an array reference of refnums or a hash reference with +refnums as keys. If no I 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; + + 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 ) { + + my $time = time; + + #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill ); + + #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( setup ); + $hash{'setup'} = $time if $old_cust_pkg[0]->setup; + + $hash{'change_date'} = $time; + $hash{"change_$_"} = $old_cust_pkg[0]->$_() foreach qw( pkgnum pkgpart ); + } + + # Create the new packages. + foreach my $pkgpart (@$pkgparts) { + 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) { + + 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 insert_reason + +Associates this package with a (suspension or cancellation) reason (see +L, possibly inserting a new reason on the fly (see +L). + +Available options are: + +=over 4 + +=item reason - can be set to a cancellation reason (see L), 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, reason - Text of the new reason. + +=item date + +=back + +If there is an error, returns the error, otherwise returns false. + +=cut + +=item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] + +PKGPARTS is a list of pkgparts specifying the the billing item definitions (see +L) to order for this customer. Duplicates are of course +permitted. + +REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to +replace. The services (see L) are moved to the +new billing items. An error is returned if this is not possible (see +L). + +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; + ''; +} + +sub insert_reason { + my ($self, %options) = @_; + + my $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, + 'date' => $options{'date'} + ? $options{'date'} + : time, + }); + + $cust_pkg_reason->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). 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) = @_; + + foreach my $cust_svc ($self->cust_svc){ + my $svc_x = $cust_svc->svc_x; + $svc_x->set_usage($valueref) + 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). 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"); + } +} + +=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, L, L, L, +L, schema.html from the base documentation + +=cut + +1; + diff --git a/FS/FS/cust_pkg_option.pm b/FS/FS/cust_pkg_option.pm new file mode 100644 index 000000000..43a153095 --- /dev/null +++ b/FS/FS/cust_pkg_option.pm @@ -0,0 +1,115 @@ +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 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, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_pkg_reason.pm b/FS/FS/cust_pkg_reason.pm new file mode 100644 index 000000000..2f927401f --- /dev/null +++ b/FS/FS/cust_pkg_reason.pm @@ -0,0 +1,122 @@ +package FS::cust_pkg_reason; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs ); + +@ISA = qw(FS::Record); + +=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 otaker - + +=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 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 $error = + $self->ut_numbern('num') + || $self->ut_number('pkgnum') + || $self->ut_number('reasonnum') + || $self->ut_text('otaker') + || $self->ut_numbern('date') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +Here be termites. Don't use on wooden computers. + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm new file mode 100644 index 000000000..53c6bac25 --- /dev/null +++ b/FS/FS/cust_refund.pm @@ -0,0 +1,352 @@ +package FS::cust_refund; + +use strict; +use vars qw( @ISA @encrypted_fields ); +use Business::CreditCard; +use FS::Record qw( qsearch qsearchs dbh ); +use FS::UID qw(getotaker); +use FS::cust_credit; +use FS::cust_credit_refund; +use FS::cust_pay_refund; +use FS::cust_main; +use FS::payinfo_Mixin; + +@ISA = qw( FS::Record FS::payinfo_Mixin ); + +@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_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) + +=item refund - Amount of the refund + +=item reason - Reason for the refund + +=item _date - specified as a UNIX timestamp; see L. Also see +L and L for conversion functions. + +=item payby - Payment Type (See L for valid payby values) + +=item payinfo - Payment Information (See L for data format) + +=item paymask - Masked payinfo (See L for how this works) + +=item paybatch - text field for tracking card processing + +=item otaker - order taker (assigned automatically, see L) + +=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 and L). + +=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 + +Currently unimplemented (accounting reasons). + +=cut + +sub replace { + my $self = shift; + $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; + + my $error = + $self->ut_numbern('refundnum') + || $self->ut_numbern('custnum') + || $self->ut_money('refund') + || $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->otaker(getotaker); + + $self->SUPER::check; +} + +=item cust_credit_refund + +Returns all applications to credits (see L) for this +refund. + +=cut + +sub cust_credit_refund { + my $self = shift; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_credit_refund', { 'refundnum' => $self->refundnum } ) + ; +} + +=item cust_pay_refund + +Returns all applications to payments (see L) for this +refund. + +=cut + +sub cust_pay_refund { + my $self = shift; + 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) and +payment applications (see L). + +=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 = shift; + + "refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + "; + +} + +=back + +=head1 BUGS + +Delete and replace methods. + +=head1 SEE ALSO + +L, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm new file mode 100644 index 000000000..8eecda3ad --- /dev/null +++ b/FS/FS/cust_svc.pm @@ -0,0 +1,705 @@ +package FS::cust_svc; + +use strict; +use vars qw( @ISA $DEBUG $me $ignore_quantity ); +use Carp; +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::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) + +=item svcpart - Service definition (see L) + +=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, L, and L, 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 method instead. + +=item cancel + +Cancels the relevant service by calling the B 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 = 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 $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) { + + 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"; + } + + } else { + + #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, $old ) = ( 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; + + $old = $new->replace_old unless defined($old); + + 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; + } + } + + 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). + +=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). + +=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; + +=cut + +sub label { + my $self = shift; + carp "FS::cust_svc::label called on $self" if $DEBUG; + my $svc_x = $self->svc_x + or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum; + + $self->_svc_label($svc_x); +} + +sub _svc_label { + my( $self, $svc_x ) = ( shift, shift ); + + ( + $self->part_svc->svc, + $svc_x->label(@_), + $self->part_svc->svcdb, + $self->svcnum + ); + +} + +=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. Equivalent to +$cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records +where B 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. Equivalent to +$cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless +for records where B is not "svc_acct". + +=cut + +#note: implementation here, POD in FS::svc_acct +sub seconds_since_sqlradacct { + my($self, $start, $end) = @_; + + 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'); + + my $dbh = DBI->connect( map { $part_export->option($_) } + qw(datasrc username password) ) + or die "can't connect to sqlradius database: ". $DBI::errstr; + + #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; + + #find closed sessions completely within the given range + my $sth = $dbh->prepare("SELECT SUM(acctsessiontime) + FROM radacct + WHERE UserName = ? + AND $str2time AcctStartTime) >= ? + AND $str2time AcctStopTime ) < ? + AND $str2time AcctStopTime ) > 0 + AND AcctStopTime IS NOT NULL" + ) or die $dbh->errstr; + $sth->execute($username, $start, $end) or die $sth->errstr; + my $regular = $sth->fetchrow_arrayref->[0]; + + #find open sessions which start in the range, count session start->range end + $query = "SELECT SUM( ? - $str2time AcctStartTime ) ) + FROM radacct + WHERE UserName = ? + 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, $start, $end, $end) + or die $sth->errstr. " executing query $query"; + my $start_during = $sth->fetchrow_arrayref->[0]; + + #find closed sessions which start before the range but stop during, + #count range start->session end + $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? ) + FROM radacct + WHERE UserName = ? + 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, $start, $start, $end ) or die $sth->errstr; + my $end_during = $sth->fetchrow_arrayref->[0]; + + #find closed (not anymore - or open) sessions which start before the range + # but stop after, or are still open, count range start->range end + # don't count open sessions (probably missing stop record) + $sth = $dbh->prepare("SELECT COUNT(*) + FROM radacct + WHERE UserName = ? + AND $str2time AcctStartTime ) < ? + AND ( $str2time AcctStopTime ) >= ? + )" + # OR AcctStopTime = 0 + # OR AcctStopTime IS NULL )" + ) or die $dbh->errstr; + $sth->execute($username, $start, $end ) or die $sth->errstr; + my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0]; + + $seconds += $regular + $end_during + $start_during + $entire_range; + + } + + $seconds; + +} + +=item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE + +See L. Equivalent to +$cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless +for records where B 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 $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'); + + my $dbh = DBI->connect( map { $part_export->option($_) } + qw(datasrc username password) ) + or die "can't connect to sqlradius database: ". $DBI::errstr; + + #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 $sth = $dbh->prepare("SELECT SUM($attrib) + FROM radacct + WHERE UserName = ? + AND $str2time AcctStopTime ) >= ? + AND $str2time AcctStopTime ) < ? + AND AcctStopTime IS NOT NULL" + ) or die $dbh->errstr; + $sth->execute($username, $start, $end) or die $sth->errstr; + + $sum += $sth->fetchrow_arrayref->[0]; + + } + + $sum; + +} + +=item get_session_history TIMESTAMP_START TIMESTAMP_END + +See L. Equivalent to +$cust_svc->svc_x->get_session_history, but more efficient. Meaningless for +records where B 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; + +} + +=item get_cdrs_for_update + +Returns (and SELECTs "FOR UPDATE") all unprocessed (freesidestatus NULL) CDR +objects (see L) associated with this service. + +CDRs are associated with svc_phone services via svc_phone.phonenum + +=cut + +sub get_cdrs_for_update { + my($self, %options) = @_; + + my $default_prefix = $options{'default_prefix'}; + + #CDRs are now associated with svc_phone services via svc_phone.phonenum + #return () unless $self->svc_x->isa('FS::svc_phone'); + return () unless $self->part_svc->svcdb eq 'svc_phone'; + my $number = $self->svc_x->phonenum; + + my @cdrs = + qsearch( { + 'table' => 'cdr', + 'hashref' => { 'freesidestatus' => '', + 'charged_party' => $number + }, + 'extra_sql' => 'FOR UPDATE', + } ); + + if ( length($default_prefix) ) { + push @cdrs, + qsearch( { + 'table' => 'cdr', + 'hashref' => { 'freesidestatus' => '', + 'charged_party' => "$default_prefix$number", + }, + 'extra_sql' => 'FOR UPDATE', + } ); + } + + #astricon hack? config option? + push @cdrs, + qsearch( { + 'table' => 'cdr', + 'hashref' => { 'freesidestatus' => '', + 'src' => $number, + }, + 'extra_sql' => 'FOR UPDATE', + } ); + + if ( length($default_prefix) ) { + push @cdrs, + qsearch( { + 'table' => 'cdr', + 'hashref' => { 'freesidestatus' => '', + 'src' => "$default_prefix$number", + }, + 'extra_sql' => 'FOR UPDATE', + } ); + } + + @cdrs; +} + +=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, L, L, L, +schema.html from the base documentation + +=cut + +1; + diff --git a/FS/FS/cust_tax_exempt.pm b/FS/FS/cust_tax_exempt.pm new file mode 100644 index 000000000..3e398877a --- /dev/null +++ b/FS/FS/cust_tax_exempt.pm @@ -0,0 +1,151 @@ +package FS::cust_tax_exempt; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs ); +use FS::cust_main; +use FS::cust_main_county; + +@ISA = qw(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) + +=item taxnum - tax rate (see L) + +=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. + +=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 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, L, L, 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 new file mode 100644 index 000000000..128921b9c --- /dev/null +++ b/FS/FS/cust_tax_exempt_pkg.pm @@ -0,0 +1,136 @@ +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; + +@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) + +=item taxnum - tax rate (see L) + +=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 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_number('year') #check better + || $self->ut_number('month') #check better + || $self->ut_money('amount') + || $self->SUPER::check + ; +} + +=back + +=head1 BUGS + +Texas tax is still a royal pain in the ass. + +=head1 SEE ALSO + +L, L, L, schema.html from +the base documentation. + +=cut + +1; + diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm new file mode 100644 index 000000000..6513abf25 --- /dev/null +++ b/FS/FS/domain_record.pm @@ -0,0 +1,438 @@ +package FS::domain_record; + +use strict; +use vars qw( @ISA $noserial_hack $DEBUG ); +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; + +=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) 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 + +=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 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->rectype =~ /^(SOA|NS|MX|A|PTR|CNAME|TXT|_mstr)$/ + or return "Illegal rectype (only SOA NS MX A PTR CNAME TXT recognized): ". + $self->rectype; + $self->rectype($1); + + 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 '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 '_mstr' ) { + $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/ + or return "Illegal data for _master pseudo-record: ". $self->recdata; + } else { + die "ack!"; + } + + $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) 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.'.' }; +} + +=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, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/export_svc.pm b/FS/FS/export_svc.pm new file mode 100644 index 000000000..0370f5f0b --- /dev/null +++ b/FS/FS/export_svc.pm @@ -0,0 +1,322 @@ +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) to +an export (see L). FS::export_svc inherits from FS::Record. +The following fields are currently supported: + +=over 4 + +=item exportsvcnum - primary key + +=item exportnum - export (see L) + +=item svcpart - service definition (see L) + +=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 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). + +=cut + +sub part_export { + my $self = shift; + qsearchs( 'part_export', { 'exportnum' => $self->exportnum } ); +} + +=item part_svc + +Returns the FS::part_svc object (see L). + +=cut + +sub part_svc { + my $self = shift; + qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/FS/h_Common.pm b/FS/FS/h_Common.pm new file mode 100644 index 000000000..ca13e1ba5 --- /dev/null +++ b/FS/FS/h_Common.pm @@ -0,0 +1,124 @@ +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, schema.html from the base documentation + +=cut + +1; + diff --git a/FS/FS/h_cust_bill.pm b/FS/FS/h_cust_bill.pm new file mode 100644 index 000000000..7a3d81146 --- /dev/null +++ b/FS/FS/h_cust_bill.pm @@ -0,0 +1,33 @@ +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, L, L, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/FS/h_cust_credit.pm b/FS/FS/h_cust_credit.pm new file mode 100644 index 000000000..1425a26a6 --- /dev/null +++ b/FS/FS/h_cust_credit.pm @@ -0,0 +1,33 @@ +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, L, L, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/FS/h_cust_pay.pm b/FS/FS/h_cust_pay.pm new file mode 100644 index 000000000..6434b3f07 --- /dev/null +++ b/FS/FS/h_cust_pay.pm @@ -0,0 +1,33 @@ +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, L, L, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/FS/h_cust_svc.pm b/FS/FS/h_cust_svc.pm new file mode 100644 index 000000000..921be3ab9 --- /dev/null +++ b/FS/FS/h_cust_svc.pm @@ -0,0 +1,161 @@ +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 { + my $self = shift; + carp "FS::h_cust_svc::label called on $self" 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->_svc_label($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, L, L, 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 new file mode 100644 index 000000000..9d2318bd5 --- /dev/null +++ b/FS/FS/h_cust_tax_exempt.pm @@ -0,0 +1,40 @@ +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. + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/h_domain_record.pm b/FS/FS/h_domain_record.pm new file mode 100644 index 000000000..0ab974fe2 --- /dev/null +++ b/FS/FS/h_domain_record.pm @@ -0,0 +1,33 @@ +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, L, L, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/FS/h_svc_acct.pm b/FS/FS/h_svc_acct.pm new file mode 100644 index 000000000..247d20c9a --- /dev/null +++ b/FS/FS/h_svc_acct.pm @@ -0,0 +1,78 @@ +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, L, L, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/FS/h_svc_broadband.pm b/FS/FS/h_svc_broadband.pm new file mode 100644 index 000000000..d6038fbe8 --- /dev/null +++ b/FS/FS/h_svc_broadband.pm @@ -0,0 +1,33 @@ +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, L, L, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/FS/h_svc_domain.pm b/FS/FS/h_svc_domain.pm new file mode 100644 index 000000000..60d54f7d1 --- /dev/null +++ b/FS/FS/h_svc_domain.pm @@ -0,0 +1,33 @@ +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, L, L, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/FS/h_svc_external.pm b/FS/FS/h_svc_external.pm new file mode 100644 index 000000000..5eb706410 --- /dev/null +++ b/FS/FS/h_svc_external.pm @@ -0,0 +1,33 @@ +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, L, L, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/FS/h_svc_forward.pm b/FS/FS/h_svc_forward.pm new file mode 100644 index 000000000..25b203904 --- /dev/null +++ b/FS/FS/h_svc_forward.pm @@ -0,0 +1,85 @@ +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, L, L, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/FS/h_svc_phone.pm b/FS/FS/h_svc_phone.pm new file mode 100644 index 000000000..95898c7b0 --- /dev/null +++ b/FS/FS/h_svc_phone.pm @@ -0,0 +1,33 @@ +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, L, L, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/FS/h_svc_www.pm b/FS/FS/h_svc_www.pm new file mode 100644 index 000000000..2a3b6dca6 --- /dev/null +++ b/FS/FS/h_svc_www.pm @@ -0,0 +1,67 @@ +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, L, L, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/FS/inventory_class.pm b/FS/FS/inventory_class.pm new file mode 100644 index 000000000..508889bca --- /dev/null +++ b/FS/FS/inventory_class.pm @@ -0,0 +1,164 @@ +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 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). + +=cut + +sub num_avail { + shift->num_sql('( svcnum IS NULL OR svcnum = 0 )'); +} + +sub num_sql { + my( $self, $sql ) = @_; + $sql = "AND $sql" if length($sql); + my $statement = + "SELECT COUNT(*) FROM inventory_item WHERE classnum = ? $sql"; + my $sth = dbh->prepare($statement) or die dbh->errstr. " preparing $statement"; + $sth->execute($self->classnum) or die $sth->errstr. " executing $statement"; + $sth->fetchrow_arrayref->[0]; +} + +=item num_used + +Returns the number of used (allocated) inventory items of this class (see +L). + +=cut + +sub num_used { + shift->num_sql("svcnum IS NOT NULL AND svcnum > 0 "); +} + +=item num_total + +Returns the total number of inventory items of this class (see +L). + +=cut + +sub num_total { + shift->num_sql(''); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/inventory_item.pm b/FS/FS/inventory_item.pm new file mode 100644 index 000000000..7fa350f2a --- /dev/null +++ b/FS/FS/inventory_item.pm @@ -0,0 +1,204 @@ +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) + +=item item - Item identifier (unique within its inventory class) + +=item svcnum - Customer servcie (see L) + +=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 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_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). + +=cut + +sub cust_svc { + my $self = shift; + return '' unless $self->svcnum; + qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } ); +} + +=back + +=head1 CLASS METHODS + +=over 4 + +=item batch_import + +=cut + +sub batch_import { + my $param = shift; + + my $fh = $param->{filehandle}; + + 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>) ) { + + chomp $line; + + my $inventory_item = new FS::inventory_item { + 'classnum' => $param->{'classnum'}, + 'item' => $line, + }; + + my $error = $inventory_item->insert; + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + + #or just skip? + #next; + } + + $imported++; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + #might want to disable this if we skip records for any reason... + return "Empty file!" unless $imported; + + ''; + +} + +=back + +=head1 BUGS + +maybe batch_import should be a regular method in FS::inventory_class + +=head1 SEE ALSO + +L, L, L, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/FS/m2m_Common.pm b/FS/FS/m2m_Common.pm new file mode 100644 index 000000000..5dc2a8ec8 --- /dev/null +++ b/FS/FS/m2m_Common.pm @@ -0,0 +1,144 @@ +package FS::m2m_Common; + +use strict; +use vars qw( @ISA $DEBUG ); +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; + +=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). + +Note: It is currently assumed that the link table contains two fields +named the same as the primary keys of ths base and target tables. + +=head1 METHODS + +=over 4 + +=item process_m2m OPTION => VALUE, ... + +Available options: + +link_table (required) - + +target_table (required) - + +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. + +=cut + +sub process_m2m { + my( $self, %opt ) = @_; + + my $self_pkey = $self->dbdef_table->primary_key; + my %hash = ( $self_pkey => $self->$self_pkey() ); + + my $link_table = $self->_load_table($opt{'link_table'}); + + my $target_table = $self->_load_table($opt{'target_table'}); + my $target_pkey = 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_pkey(); + ( ! $opt{'params'}->{$targetnum} + && ! $opt{'params'}->{"$target_pkey$targetnum"} + ); + } + qsearch( $link_table, \%hash ) + ) { + my $error = $del_obj->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + foreach my $add_targetnum ( + grep { ! qsearchs( $link_table, { %hash, $target_pkey => $_ } ) } + map { /^($target_pkey)?(\d+)$/; $2; } + grep { /^($target_pkey)?(\d+)$/ } + grep { $opt{'params'}->{$_} } + keys %{ $opt{'params'} } + ) { + + my $add_obj = "FS::$link_table"->new( { + %hash, + $target_pkey => $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 + +=cut + +1; + diff --git a/FS/FS/m2name_Common.pm b/FS/FS/m2name_Common.pm new file mode 100644 index 000000000..e9dcee9b9 --- /dev/null +++ b/FS/FS/m2name_Common.pm @@ -0,0 +1,177 @@ +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 CVars)> from a form. Processing is controlled by the B option. + +param_style (required) - Controls processing of B. I<'link_table.value checkboxes'> specifies that parameters keys are in the form C, 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, C, 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 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 + +=cut + +1; + diff --git a/FS/FS/msgcat.pm b/FS/FS/msgcat.pm new file mode 100644 index 000000000..cbdc1d633 --- /dev/null +++ b/FS/FS/msgcat.pm @@ -0,0 +1,133 @@ +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 message catalogs, see L. + +=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 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 +} + +=back + +=head1 BUGS + +i18n/l10n, eek + +=head1 SEE ALSO + +L, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/nas.pm b/FS/FS/nas.pm new file mode 100644 index 000000000..97b0ea17d --- /dev/null +++ b/FS/FS/nas.pm @@ -0,0 +1,150 @@ +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 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, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/option_Common.pm b/FS/FS/option_Common.pm new file mode 100644 index 000000000..441e798d2 --- /dev/null +++ b/FS/FS/option_Common.pm @@ -0,0 +1,345 @@ +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 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 = + ( ref($_[0]) eq 'HASH' ) + ? shift + : { @_ }; + + 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 + 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_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 + +=cut + +1; + diff --git a/FS/FS/part_bill_event.pm b/FS/FS/part_bill_event.pm new file mode 100644 index 000000000..1d48af9fc --- /dev/null +++ b/FS/FS/part_bill_event.pm @@ -0,0 +1,363 @@ +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; + +@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. + +=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 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 { $_->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, L, L, schema.html from the +base documentation. + +=cut + +1; + diff --git a/FS/FS/part_event.pm b/FS/FS/part_event.pm new file mode 100644 index 000000000..d0ab65e3f --- /dev/null +++ b/FS/FS/part_event.pm @@ -0,0 +1,428 @@ +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) + +=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) + +=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 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). + +=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). + +=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', [ 'cust_bill', 'cust_main', 'cust_pkg' ] ) + || $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 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) + +=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) 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', + ; + + \%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 %hash = ( + 'cust_main' => 'cust_main.custnum', + 'cust_bill' => 'cust_bill.invnum', + 'cust_pkg' => 'cust_pkg.pkgnum', + 'cust_pay_batch' => 'cust_pay_batch.paybatchnum', + ); + + \%hash; +} + + +=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 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, L, L, +L, L, L, L, +schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_event/Action.pm b/FS/FS/part_event/Action.pm new file mode 100644 index 000000000..bdb9df603 --- /dev/null +++ b/FS/FS/part_event/Action.pm @@ -0,0 +1,224 @@ +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 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: + +=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 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) 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; +} + +=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/addpost.pm b/FS/FS/part_event/Action/addpost.pm new file mode 100644 index 000000000..e0e3fa878 --- /dev/null +++ b/FS/FS/part_event/Action/addpost.pm @@ -0,0 +1,24 @@ +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 new file mode 100644 index 000000000..f91c6047e --- /dev/null +++ b/FS/FS/part_event/Action/apply.pm @@ -0,0 +1,28 @@ +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 new file mode 100644 index 000000000..fec025f62 --- /dev/null +++ b/FS/FS/part_event/Action/bill.pm @@ -0,0 +1,30 @@ +package FS::part_event::Action::bill; + +use strict; +use base qw( FS::part_event::Action ); + +sub description { + #'Generate invoices (normally only used with a Late Fee 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 new file mode 100644 index 000000000..94f314602 --- /dev/null +++ b/FS/FS/part_event/Action/cancel.pm @@ -0,0 +1,35 @@ +package FS::part_event::Action::cancel; + +use strict; +use base qw( FS::part_event::Action ); + +sub description { + 'Cancel'; +} + +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 new file mode 100644 index 000000000..fa94b7def --- /dev/null +++ b/FS/FS/part_event/Action/collect.pm @@ -0,0 +1,30 @@ +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 Late Fee and Generate Invoice 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 new file mode 100644 index 000000000..aec09250b --- /dev/null +++ b/FS/FS/part_event/Action/cust_bill_batch.pm @@ -0,0 +1,31 @@ +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 new file mode 100644 index 000000000..636a66df5 --- /dev/null +++ b/FS/FS/part_event/Action/cust_bill_comp.pm @@ -0,0 +1,34 @@ +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_fee_percent.pm b/FS/FS/part_event/Action/cust_bill_fee_percent.pm new file mode 100644 index 000000000..100fc8bc3 --- /dev/null +++ b/FS/FS/part_event/Action/cust_bill_fee_percent.pm @@ -0,0 +1,40 @@ +package FS::part_event::Action::cust_bill_fee_percent; + +use strict; +use base qw( FS::part_event::Action ); + +sub description { + 'Late fee (percentage of invoice)'; +} + +sub eventtable_hashref { + { 'cust_bill' => 1 }; +} + +sub option_fields { + ( + 'percent' => { label=>'Percent', size=>2, }, + 'reason' => 'Reason', + ); +} + +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 $error = $cust_main->charge( + sprintf('%.2f', $cust_bill->owed * $self->option('percent') / 100 ), + $self->option('reason') + ); + die $error if $error; + + ''; +} + +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 new file mode 100644 index 000000000..471c946dc --- /dev/null +++ b/FS/FS/part_event/Action/cust_bill_realtime_card.pm @@ -0,0 +1,32 @@ +package FS::part_event::Action::cust_bill_realtime_card; + +use strict; +use base qw( FS::part_event::Action ); + +sub description { + #'Run card with a Business::OnlinePayment 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 new file mode 100644 index 000000000..9a52830ae --- /dev/null +++ b/FS/FS/part_event/Action/cust_bill_realtime_check.pm @@ -0,0 +1,32 @@ +package FS::part_event::Action::cust_bill_realtime_check; + +use strict; +use base qw( FS::part_event::Action ); + +sub description { + #'Run check with a Business::OnlinePayment 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 new file mode 100644 index 000000000..db091dadb --- /dev/null +++ b/FS/FS/part_event/Action/cust_bill_realtime_lec.pm @@ -0,0 +1,32 @@ +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 Business::OnlinePayment 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 new file mode 100644 index 000000000..9330c6113 --- /dev/null +++ b/FS/FS/part_event/Action/cust_bill_send.pm @@ -0,0 +1,27 @@ +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 ) = @_; + + #my $cust_main = $self->cust_main($cust_bill); + my $cust_main = $cust_bill->cust_main; + + $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 new file mode 100644 index 000000000..fcf000736 --- /dev/null +++ b/FS/FS/part_event/Action/cust_bill_send_agent.pm @@ -0,0 +1,44 @@ +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 new file mode 100644 index 000000000..6afb89a99 --- /dev/null +++ b/FS/FS/part_event/Action/cust_bill_send_alternate.pm @@ -0,0 +1,35 @@ +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 new file mode 100644 index 000000000..db3554e01 --- /dev/null +++ b/FS/FS/part_event/Action/cust_bill_send_csv_ftp.pm @@ -0,0 +1,56 @@ +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 new file mode 100644 index 000000000..916983ebe --- /dev/null +++ b/FS/FS/part_event/Action/cust_bill_send_if_newest.pm @@ -0,0 +1,40 @@ +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_spool_csv.pm b/FS/FS/part_event/Action/cust_bill_spool_csv.pm new file mode 100644 index 000000000..4300b6120 --- /dev/null +++ b/FS/FS/part_event/Action/cust_bill_spool_csv.pm @@ -0,0 +1,64 @@ +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', + }, + ); +} + +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 new file mode 100644 index 000000000..655994963 --- /dev/null +++ b/FS/FS/part_event/Action/cust_bill_suspend_if_balance.pm @@ -0,0 +1,48 @@ +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/fee.pm b/FS/FS/part_event/Action/fee.pm new file mode 100644 index 000000000..81a84498a --- /dev/null +++ b/FS/FS/part_event/Action/fee.pm @@ -0,0 +1,33 @@ +package FS::part_event::Action::fee; + +use strict; +use base qw( FS::part_event::Action ); + +sub description { + 'Late fee (flat)'; +} + +sub option_fields { + ( + 'charge' => { label=>'Amount', type=>'money', }, # size=>7, }, + 'reason' => 'Reason', + ); +}; + +sub default_weight { + 10; +} + +sub do_action { + my( $self, $cust_object ) = @_; + + my $cust_main = $self->cust_main($cust_object); + + my $error = $cust_main->charge( $self->option('charge'), $self->option('reason') ); + + die $error if $error; + + ''; +} + +1; diff --git a/FS/FS/part_event/Action/suspend.pm b/FS/FS/part_event/Action/suspend.pm new file mode 100644 index 000000000..ec440ffd2 --- /dev/null +++ b/FS/FS/part_event/Action/suspend.pm @@ -0,0 +1,36 @@ +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 new file mode 100644 index 000000000..9bdc9be53 --- /dev/null +++ b/FS/FS/part_event/Action/suspend_if_pkgpart.pm @@ -0,0 +1,42 @@ +package FS::part_event::Action::suspend_if_pkgpart; + +use strict; +use base qw( FS::part_event::Action ); + +sub description { + 'Suspend packages'; +} + +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 new file mode 100644 index 000000000..f9bf1e860 --- /dev/null +++ b/FS/FS/part_event/Action/suspend_unless_pkgpart.pm @@ -0,0 +1,42 @@ +package FS::part_event::Action::suspend_unless_pkgpart; + +use strict; +use base qw( FS::part_event::Action ); + +sub description { + 'Suspend packages except'; +} + +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/Condition.pm b/FS/FS/part_event/Condition.pm new file mode 100644 index 000000000..2b71fbb77 --- /dev/null +++ b/FS/FS/part_event/Condition.pm @@ -0,0 +1,412 @@ +package FS::part_event::Condition; + +use strict; +use base qw( FS::part_event_condition ); + +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, + }; + } + +=cut + +#fallback +sub eventtable_hashref { + { 'cust_main' => 1, + 'cust_bill' => 1, + 'cust_pkg' => 1, + 'cust_pay_batch' => 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 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 +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 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 and I conditions. You probably +do B want to define this method for new custom conditions, unless you're +sure you want B 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 +Is.) 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 and I 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 and I 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 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) 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 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. + +=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' + )"; +} + +=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. + +=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 +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. + +=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. 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 new file mode 100644 index 000000000..da428c15f --- /dev/null +++ b/FS/FS/part_event/Condition/agent.pm @@ -0,0 +1,37 @@ +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 new file mode 100644 index 000000000..54c893260 --- /dev/null +++ b/FS/FS/part_event/Condition/agent_type.pm @@ -0,0 +1,40 @@ +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 new file mode 100644 index 000000000..263941351 --- /dev/null +++ b/FS/FS/part_event/Condition/balance.pm @@ -0,0 +1,48 @@ +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 > $over"; + +} + +1; + diff --git a/FS/FS/part_event/Condition/balance_age.pm b/FS/FS/part_event/Condition/balance_age.pm new file mode 100644 index 000000000..ec3624a6d --- /dev/null +++ b/FS/FS/part_event/Condition/balance_age.pm @@ -0,0 +1,77 @@ +package FS::part_event::Condition::balance_age; + +require 5.006; +use strict; +use Time::Local qw(timelocal_nocheck); + +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); + + #false laziness w/cust_bill_age + my $time = $opt{'time'}; + my $age = $self->option('age'); + $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"; + } + my $age_date = timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year); + + $cust_main->balance_date($age_date) > $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 > $over"; +} + +sub order_sql { + shift->condition_sql_option_age('age'); +} + +use FS::UID qw( driver_name ); + +sub order_sql_weight { + 10; +} + +1; diff --git a/FS/FS/part_event/Condition/balance_under.pm b/FS/FS/part_event/Condition/balance_under.pm new file mode 100644 index 000000000..5e1903468 --- /dev/null +++ b/FS/FS/part_event/Condition/balance_under.pm @@ -0,0 +1,42 @@ +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 <= $under"; + +} + +1; + diff --git a/FS/FS/part_event/Condition/cust_bill_age.pm b/FS/FS/part_event/Condition/cust_bill_age.pm new file mode 100644 index 000000000..5c1e46869 --- /dev/null +++ b/FS/FS/part_event/Condition/cust_bill_age.pm @@ -0,0 +1,75 @@ +package FS::part_event::Condition::cust_bill_age; + +require 5.006; +use strict; +use Time::Local qw(timelocal_nocheck); + +use base qw( FS::part_event::Condition ); + +sub description { + 'Invoice age'; +} + +sub eventtable_hashref { + { 'cust_main' => 0, + 'cust_bill' => 1, + 'cust_pkg' => 0, + }; +} + +#something like this +sub option_fields { + ( + #'days' => { label=>'Days', size=>3, }, + 'age' => { label=>'Age', type=>'freq', }, + ); +} + +sub condition { + my( $self, $cust_bill, %opt ) = @_; + + #false laziness w/balance_age + my $time = $opt{'time'}; + my $age = $self->option('age'); + $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"; + } + my $age_date = timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year); + + $cust_bill->_date <= $age_date; + +} + +# and seconds <= $time - cust_bill._date + +sub condition_sql { + my( $class, $table, %opt ) = @_; + + my $age = $class->condition_sql_option_age_from('age', $opt{'time'} ); + + "cust_bill._date <= $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_service.pm b/FS/FS/part_event/Condition/cust_bill_has_service.pm new file mode 100644 index 000000000..be7ea2b02 --- /dev/null +++ b/FS/FS/part_event/Condition/cust_bill_has_service.pm @@ -0,0 +1,54 @@ +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 == $_->svcnum } + map { $_->cust_pkg->cust_svc } + $cust_bill->cust_bill_pkg ; +} + +sub condition_sql { + my( $class, $table ) = @_; + + 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 = $servicenum + ) + |; + 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 new file mode 100644 index 000000000..5e582ef69 --- /dev/null +++ b/FS/FS/part_event/Condition/cust_bill_owed.pm @@ -0,0 +1,54 @@ +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 > $over"; +} + +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 new file mode 100644 index 000000000..460e6a4be --- /dev/null +++ b/FS/FS/part_event/Condition/cust_bill_owed_under.pm @@ -0,0 +1,49 @@ +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 <= $under"; +} + +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 new file mode 100644 index 000000000..b3a8d705f --- /dev/null +++ b/FS/FS/part_event/Condition/cust_pay_batch_declined.pm @@ -0,0 +1,51 @@ +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_status.pm b/FS/FS/part_event/Condition/cust_status.pm new file mode 100644 index 000000000..fbdff25a5 --- /dev/null +++ b/FS/FS/part_event/Condition/cust_status.pm @@ -0,0 +1,32 @@ +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 }; +} + +1; diff --git a/FS/FS/part_event/Condition/every.pm b/FS/FS/part_event/Condition/every.pm new file mode 100644 index 000000000..3408b0aa9 --- /dev/null +++ b/FS/FS/part_event/Condition/every.pm @@ -0,0 +1,67 @@ +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/once.pm b/FS/FS/part_event/Condition/once.pm new file mode 100644 index 000000000..5a9161f06 --- /dev/null +++ b/FS/FS/part_event/Condition/once.pm @@ -0,0 +1,55 @@ +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 sucessfully"; } + +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/payby.pm b/FS/FS/part_event/Condition/payby.pm new file mode 100644 index 000000000..d93156828 --- /dev/null +++ b/FS/FS/part_event/Condition/payby.pm @@ -0,0 +1,50 @@ +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); + + #uuh.. all right? test this. + my $hashref = $self->option('payby') || {}; + $hashref->{ $cust_main->payby }; + +} + +#sub condition_sql { +# my( $self, $table ) = @_; +# +# #uuh... yeah... something like this. test it for sure. +# +# my @payby = keys %{ $self->option('payby') }; +# +# ' ( '. join(' OR ', map { "cust_main.payby = '$_'" } @payby ). ' ) '; +# +#} + +1; diff --git a/FS/FS/part_event/Condition/pkg_class.pm b/FS/FS/part_event/Condition/pkg_class.pm new file mode 100644 index 000000000..8c9031c6b --- /dev/null +++ b/FS/FS/part_event/Condition/pkg_class.pm @@ -0,0 +1,38 @@ +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_status.pm b/FS/FS/part_event/Condition/pkg_status.pm new file mode 100644 index 000000000..6c1c9cca5 --- /dev/null +++ b/FS/FS/part_event/Condition/pkg_status.pm @@ -0,0 +1,37 @@ +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 }; +} + +1; diff --git a/FS/FS/part_event_condition.pm b/FS/FS/part_event_condition.pm new file mode 100644 index 000000000..d13e84927 --- /dev/null +++ b/FS/FS/part_event_condition.pm @@ -0,0 +1,352 @@ +package FS::part_event_condition; + +use strict; +use vars qw( @ISA $DEBUG @SKIP_CONDITION_SQL ); +use FS::UID qw(dbh); +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) + +=item conditionname - Condition name - defines which FS::part_event::Condition::I 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 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). + +=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). + +=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 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 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". Typically used in conjunction with +B. + +=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. + +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 ); + 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. + +=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, L, L, 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 new file mode 100644 index 000000000..3256dc0bd --- /dev/null +++ b/FS/FS/part_event_condition_option.pm @@ -0,0 +1,151 @@ +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) + +=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 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). + +=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). + +=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, L, +L, 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 new file mode 100644 index 000000000..7396c2229 --- /dev/null +++ b/FS/FS/part_event_condition_option_option.pm @@ -0,0 +1,129 @@ +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) + +=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 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, L, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/FS/part_event_option.pm b/FS/FS/part_event_option.pm new file mode 100644 index 000000000..43e1da933 --- /dev/null +++ b/FS/FS/part_event_option.pm @@ -0,0 +1,213 @@ +package FS::part_event_option; + +use strict; +use vars qw( @ISA ); +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) + +=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 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, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm new file mode 100644 index 000000000..6adcab94d --- /dev/null +++ b/FS/FS/part_export.pm @@ -0,0 +1,461 @@ +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 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 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). + +=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_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) 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 part_export_option + +Returns all options as FS::part_export_option objects (see +L). + +=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 field. There should be better docs +on how to create new exports, but until then, see L. + +=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 ); +} + +=back + +=head1 SUBROUTINES + +=over 4 + +=item export_info [ SVCDB ] + +Returns a hash reference of the exports for the given I, or if no +I is specified, for all exports. The keys of the hash are +Is 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 for an I. +# +#=cut +# +#sub exporttype2svcdb { +# my $exporttype = $_[0]; +# foreach my $svcdb ( keys %exports ) { +# return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}}; +# } +# ''; +#} + +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, L, L, +L, +L, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_export/acct_plesk.pm b/FS/FS/part_export/acct_plesk.pm new file mode 100644 index 000000000..1be820a75 --- /dev/null +++ b/FS/FS/part_export/acct_plesk.pm @@ -0,0 +1,121 @@ +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 +Plesk managed server. +Requires installation of +Net::Plesk +from CPAN. +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 new file mode 100644 index 000000000..9f1ae7b5c --- /dev/null +++ b/FS/FS/part_export/acct_sql.pm @@ -0,0 +1,310 @@ +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' => <
    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. + +

    Use these buttons for some useful presets: +
      +
    • +
    • +
    • +
    • +
    +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/apache.pm b/FS/FS/part_export/apache.pm new file mode 100644 index 000000000..35b00cc96 --- /dev/null +++ b/FS/FS/part_export/apache.pm @@ -0,0 +1,47 @@ +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', + #generic +# #preferred, http://httpd.apache.org/docs/dns-caveats.html +DocumentRoot /var/www/$zone +ServerName $zone +ServerAlias *.$zone +#BandWidthModule On +#LargeFileLimit 4096 12288 +#FrontpageEnable on + + +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 Include /etc/apache/httpd-freeside.conf in +httpd.conf. File::Rsync +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 new file mode 100644 index 000000000..c006db9cd --- /dev/null +++ b/FS/FS/part_export/artera_turbo.pm @@ -0,0 +1,181 @@ +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 Artera Turbo +Reseller API. Requires installation of +Net::Artera +from CPAN. You probably also want to: +
      +
    • In the configuration UI section: set the svc_external-skip_manual and svc_external-display_type configuration values. +
    • In the message catalog: set svc_external-id to Artera Serial Number and set svc_external-title to Artera Key Code. +
    +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 new file mode 100644 index 000000000..1ef7b6598 --- /dev/null +++ b/FS/FS/part_export/bind.pm @@ -0,0 +1,35 @@ +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. +File::Rsync +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 new file mode 100644 index 000000000..c89325f8d --- /dev/null +++ b/FS/FS/part_export/bind_slave.pm @@ -0,0 +1,28 @@ +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. +File::Rsync +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 new file mode 100644 index 000000000..7b5feb252 --- /dev/null +++ b/FS/FS/part_export/bsdshell.pm @@ -0,0 +1,25 @@ +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 +Crypt::PasswdMD5 +from CPAN. Run bin/bsdshell.export to export the files. +END +); + +1; + diff --git a/FS/FS/part_export/communigate_pro.pm b/FS/FS/part_export/communigate_pro.pm new file mode 100644 index 000000000..ecb378090 --- /dev/null +++ b/FS/FS/part_export/communigate_pro.pm @@ -0,0 +1,178 @@ +package FS::part_export::communigate_pro; + +use vars qw(@ISA %info %options); +use Tie::IxHash; +use FS::part_export; +use FS::queue; + +@ISA = qw(FS::part_export); + +tie %options, 'Tie::IxHash', + 'port' => { label=>'Port number', default=>'106', }, + 'login' => { label=>'The administrator account name. The name can contain a domain part.', }, + 'password' => { label=>'The administrator account password.', }, + 'accountType' => { label=>'Type for newly-created accounts', + type=>'select', + options=>[qw( MultiMailbox TextMailbox MailDirMailbox )], + default=>'MultiMailbox', + }, + 'externalFlag' => { label=> 'Create accounts with an external (visible for legacy mailers) INBOX.', + type=>'checkbox', + }, + 'AccessModes' => { label=>'Access modes', + default=>'Mail POP IMAP PWD WebMail WebSite', + }, +; + +%info = ( + 'svc' => 'svc_acct', + 'desc' => 'Real-time export to a CommuniGate Pro mail server', + 'options' => \%options, + 'notes' => <<'END' +Real time export to a +CommuniGate Pro +mail server. The +CommuniGate Pro Perl Interface +must be installed as CGP::CLI. +END +); + +sub rebless { shift; } + +sub export_username { + my($self, $svc_acct) = (shift, shift); + $svc_acct->email; +} + +sub _export_insert { + my( $self, $svc_acct ) = (shift, shift); + my @options = ( $svc_acct->svcnum, 'CreateAccount', + 'accountName' => $self->export_username($svc_acct), + 'accountType' => $self->option('accountType'), + 'AccessModes' => $self->option('AccessModes'), + 'RealName' => $svc_acct->finger, + 'Password' => $svc_acct->_password, + ); + push @options, 'MaxAccountSize' => $svc_acct->quota if $svc_acct->quota; + push @options, 'externalFlag' => $self->option('externalFlag') + if $self->option('externalFlag'); + + $self->communigate_pro_queue( @options ); +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + return "can't (yet) change username with CommuniGate Pro" + if $old->username ne $new->username; + return "can't (yet) change domain with CommuniGate Pro" + if $self->export_username($old) ne $self->export_username($new); + return "can't (yet) change GECOS with CommuniGate Pro" + if $old->finger ne $new->finger; + return "can't (yet) change quota with CommuniGate Pro" + if $old->quota ne $new->quota; + return '' unless $old->username ne $new->username + || $old->_password ne $new->_password + || $old->finger ne $new->finger + || $old->quota ne $new->quota; + + return '' if '*SUSPENDED* '. $old->_password eq $new->_password; + + #my $err_or_queue = $self->communigate_pro_queue( $new->svcnum,'RenameAccount', + # $old->email, $new->email ); + #return $err_or_queue unless ref($err_or_queue); + #my $jobnum = $err_or_queue->jobnum; + + $self->communigate_pro_queue( $new->svcnum, 'SetAccountPassword', + $self->export_username($new), $new->_password ) + if $new->_password ne $old->_password; + +} + +sub _export_delete { + my( $self, $svc_acct ) = (shift, shift); + $self->communigate_pro_queue( $svc_acct->svcnum, 'DeleteAccount', + $self->export_username($svc_acct), + ); +} + +sub _export_suspend { + my( $self, $svc_acct ) = (shift, shift); + $self->communigate_pro_queue( $svc_acct->svcnum, 'UpdateAccountSettings', + 'accountName' => $self->export_username($svc_acct), + 'AccessModes' => 'Mail', + ); +} + +sub _export_unsuspend { + my( $self, $svc_acct ) = (shift, shift); + $self->communigate_pro_queue( $svc_acct->svcnum, 'UpdateAccountSettings', + 'accountName' => $self->export_username($svc_acct), + 'AccessModes' => $self->option('AccessModes'), + ); +} + +sub communigate_pro_queue { + my( $self, $svcnum, $method ) = (shift, shift, shift); + my @kludge_methods = qw(CreateAccount UpdateAccountSettings); + my $sub = 'communigate_pro_command'; + $sub = $method if grep { $method eq $_ } @kludge_methods; + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::communigate_pro::$sub", + }; + $queue->insert( + $self->machine, + $self->option('port'), + $self->option('login'), + $self->option('password'), + $method, + @_, + ); + +} + +sub CreateAccount { + my( $machine, $port, $login, $password, $method, %args ) = @_; + my $accountName = delete $args{'accountName'}; + my $accountType = delete $args{'accountType'}; + my $externalFlag = delete $args{'externalFlag'}; + $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ]; + my @args = ( accountName => $accountName, + accountType => $accountType, + settings => \%args, + ); + #externalFlag => $externalFlag, + push @args, externalFlag => $externalFlag if $externalFlag; + + communigate_pro_command( $machine, $port, $login, $password, $method, @args ); + +} + +sub UpdateAccountSettings { + my( $machine, $port, $login, $password, $method, %args ) = @_; + my $accountName = delete $args{'accountName'}; + $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ]; + @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"; + + my $cli = new CGP::CLI( { + 'PeerAddr' => $machine, + 'PeerPort' => $port, + 'login' => $login, + 'password' => $password, + } ) or die "Can't login to CGPro: $CGP::ERR_STRING\n"; + + $cli->$method(@args) or die "CGPro error: ". $cli->getErrMessage; + + $cli->Logout; # or die "Can't logout of CGPro: $CGP::ERR_STRING\n"; + +} + +1; + diff --git a/FS/FS/part_export/communigate_pro_singledomain.pm b/FS/FS/part_export/communigate_pro_singledomain.pm new file mode 100644 index 000000000..e25043fbb --- /dev/null +++ b/FS/FS/part_export/communigate_pro_singledomain.pm @@ -0,0 +1,37 @@ +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 +CommuniGate Pro +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 +CommuniGate Pro Perl Interface +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 new file mode 100644 index 000000000..96fa43710 --- /dev/null +++ b/FS/FS/part_export/cp.pm @@ -0,0 +1,161 @@ +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 +Critial Path Account Provisioning Protocol. +Requires installation of +Net::APP +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 new file mode 100644 index 000000000..0ad00df01 --- /dev/null +++ b/FS/FS/part_export/cpanel.pm @@ -0,0 +1,192 @@ +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 Cpanel 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/cyrus.pm b/FS/FS/part_export/cyrus.pm new file mode 100644 index 000000000..84c9e5a30 --- /dev/null +++ b/FS/FS/part_export/cyrus.pm @@ -0,0 +1,120 @@ +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 +Cyrus IMAP Server. +Cyrus::IMAP::Admin should be installed locally and the connection to the +server secured. svc_acct.quota, 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/domain_shellcommands.pm b/FS/FS/part_export/domain_shellcommands.pm new file mode 100644 index 000000000..994c113bf --- /dev/null +++ b/FS/FS/part_export/domain_shellcommands.pm @@ -0,0 +1,165 @@ +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 +setup SSH for unattended operation. +

    Use these buttons for some useful presets: +
      +
    • + +
    • + +
    +The following variables are available for interpolation (prefixed with new_ or old_ for replace operations): +
      +
    • $domain +
    • $qdomain - domain with periods replaced by colons +
    • $uid - of catchall account +
    • $gid - of catchall account +
    • $dir - home directory of catchall account +
    • All other fields in + svc_domain are also available. +
    +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 new file mode 100644 index 000000000..0ce1b16e3 --- /dev/null +++ b/FS/FS/part_export/domain_sql.pm @@ -0,0 +1,238 @@ +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' => <
    Use these buttons for useful presets: +
      +
    • +
    +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 @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 = $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 %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/everyone_net.pm b/FS/FS/part_export/everyone_net.pm new file mode 100644 index 000000000..e04318e10 --- /dev/null +++ b/FS/FS/part_export/everyone_net.pm @@ -0,0 +1,132 @@ +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 +Everyone.net via the XRC Remote API. +Requires installation of +Net::XRC +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 new file mode 100644 index 000000000..cee24e452 --- /dev/null +++ b/FS/FS/part_export/forward_shellcommands.pm @@ -0,0 +1,182 @@ +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 +setup SSH for unattended operation. +

    Use these buttons for some useful presets: +
      +
    • + +
    • + +
    +The following variables are available for interpolation (prefixed with +new_ or old_ for replace operations): +
      +
    • $username - username of forward source +
    • $domain - domain of forward source +
    • $source - forward source ($username@$domain) +
    • $destination - forward destination +
    • All other fields in svc_forward are also available. +
    +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/http.pm b/FS/FS/part_export/http.pm new file mode 100644 index 000000000..55d832966 --- /dev/null +++ b/FS/FS/part_export/http.pm @@ -0,0 +1,134 @@ +package FS::part_export::http; + +use vars qw(@ISA %info); +use Tie::IxHash; +use FS::part_export; + +@ISA = qw(FS::part_export); + +tie my %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", + ), + }, +; + +%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, +Crypt::SSLeay +or IO::Socket::SSL +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"); + + $self->http_queue( $svc_x->svcnum, + $self->option('method'), + $self->option('url'), + 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'); + + $self->http_queue( $svc_x->svcnum, + $self->option('method'), + $self->option('url'), + map { + /^\s*(\S+)\s+(.*)$/ or /()()/; + my( $field, $value_expression ) = ( $1, $2 ); + die $@ if $@; + ( $field, $value ); + } split(/\n/, $self->option('replace_data') ) + ); + +} + +sub http_queue { + my($self, $svcnum) = (shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::http::http", + }; + $queue->insert( @_ ); +} + +sub http { + my($method, $url, @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; + +} + +1; + diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm new file mode 100644 index 000000000..ef16c7c54 --- /dev/null +++ b/FS/FS/part_export/infostreet.pm @@ -0,0 +1,277 @@ +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 +InfoStreet streetSmartAPI. +Requires installation of +Frontier::Client 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/ldap.pm b/FS/FS/part_export/ldap.pm new file mode 100644 index 000000000..823d99dbf --- /dev/null +++ b/FS/FS/part_export/ldap.pm @@ -0,0 +1,294 @@ +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' }, + '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 +Net::LDAP from CPAN. +END +); + +@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); + +sub rebless { shift; } + +sub _export_insert { + my($self, $svc_acct) = (shift, shift); + + #false laziness w/shellcommands.pm + { + no strict 'refs'; + ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; + ${$_} = $svc_acct->$_() foreach qw( domain ); + 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); + } + } + $crypt_password = ''; #surpress "used only once" warnings + $crypt_password = '{crypt}'. crypt( $svc_acct->_password, + $saltset[int(rand(64))].$saltset[int(rand(64))] ); + + my $username_attrib; + my %attrib = map { /^\s*(\w+)\s+(.*\S)\s*$/; + $username_attrib = $1 if $2 eq '$username'; + ( $1 => eval(qq("$2")) ); } + grep { /^\s*(\w+)\s+(.*\S)\s*$/ } + split("\n", $self->option('attributes')); + + 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}; + } + } + } + + my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'insert', + #$svc_acct->username, + $username_attrib, + %attrib ); + return $err_or_queue unless ref($err_or_queue); + + #groups with LDAP? + #my @groups = $svc_acct->radius_groups; + #if ( @groups ) { + # my $err_or_queue = $self->ldap_queue( + # $svc_acct->svcnum, 'usergroup_insert', + # $svc_acct->username, @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'; + + return "can't (yet?) change username with ldap" + if $old->username ne $new->username; + + return "ldap replace unimplemented"; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $jobnum = ''; + #if ( $old->username ne $new->username ) { + # my $err_or_queue = $self->ldap_queue( $new->svcnum, 'rename', + # $new->username, $old->username ); + # 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->ldap_queue( $new->svcnum, 'insert', + $table, $new->username, %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->ldap_queue( $new->svcnum, 'attrib_delete', + $table, $new->username, @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; + } + } + } + } + + # (sorta) false laziness with FS::svc_acct::replace + my @oldgroups = @{$old->usergroup}; #uuuh + my @newgroups = $new->radius_groups; + my @delgroups = (); + foreach my $oldgroup ( @oldgroups ) { + if ( grep { $oldgroup eq $_ } @newgroups ) { + @newgroups = grep { $oldgroup ne $_ } @newgroups; + next; + } + push @delgroups, $oldgroup; + } + + if ( @delgroups ) { + my $err_or_queue = $self->ldap_queue( $new->svcnum, 'usergroup_delete', + $new->username, @delgroups ); + 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; + } + } + } + + if ( @newgroups ) { + my $err_or_queue = $self->ldap_queue( $new->svcnum, 'usergroup_insert', + $new->username, @newgroups ); + 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; + } + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; +} + +sub _export_delete { + my( $self, $svc_acct ) = (shift, shift); + return "ldap delete unimplemented"; + my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'delete', + $svc_acct->username ); + 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, $username_attrib, %attrib ) = @_; + + $userdn = "$username_attrib=$attrib{$username_attrib}, $userdn" + if $username_attrib; + #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 { #subroutine, not method +# my $dbh = ldap_connect(shift, shift, shift); +# my $username = shift; +# +# 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 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 new file mode 100644 index 000000000..2499ba3ee --- /dev/null +++ b/FS/FS/part_export/nas_wrapper.pm @@ -0,0 +1,311 @@ +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. + +=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/null.pm b/FS/FS/part_export/null.pm new file mode 100644 index 000000000..0145af3a4 --- /dev/null +++ b/FS/FS/part_export/null.pm @@ -0,0 +1,13 @@ +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 new file mode 100644 index 000000000..2978d2503 --- /dev/null +++ b/FS/FS/part_export/passwdfile.pm @@ -0,0 +1,18 @@ +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/postfix.pm b/FS/FS/part_export/postfix.pm new file mode 100644 index 000000000..4fd19ee61 --- /dev/null +++ b/FS/FS/part_export/postfix.pm @@ -0,0 +1,32 @@ +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. +File::Rsync +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 new file mode 100644 index 000000000..3ba1b2762 --- /dev/null +++ b/FS/FS/part_export/prizm.pm @@ -0,0 +1,532 @@ +package FS::part_export::prizm; + +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 => '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 svc_broadband, cust_pkg, and cust_main +record data to Motorola +Canopy Prizm +software via the Northbound interface.

    + +Freeside will attempt to create an element in an existing network with the +values provided in svc_broadband. Of particular interest are +
      +
    • mac address - used to identify the element +
    • vlan profile - an exact match for a vlan profiles defined in prizm +
    • ip address - defines the management ip address of the prizm element +
    • latitude - GPS latitude +
    • longitude - GPS longitude +
    • altitude - GPS altitude +
    + +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. + +
      +
    • importId - the freeside customer number +
    • customerType - freeside +
    • customerName - the name associated with the freeside shipping address +
    • address1 - the shipping address +
    • address2 +
    • city +
    • state +
    • zipCode +
    • country +
    • workPhone - the daytime phone number +
    • homePhone - the night phone number +
    • freesideId - the freeside customer number +
    + + Additionally set on the element are +
      +
    • Site Name - The shipping name followed by the service broadband description field +
    • Site Location - the shipping address +
    • Site Contact - the daytime and night phone numbers +
    + +Freeside provisions, suspends, and unsuspends elements BAM only unless the +'Full EMS' checkbox is checked.

    + +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 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 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 ); + + 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; + }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 "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; +# } +# } + + 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), + $svc->cust_svc->cust_pkg->part_pkg->pkg, + $svc->vlan_profile, + ($self->option('ems') ? 1 : 0 ), + ); + return $err_or_som + unless ref($err_or_som); + + 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); + + $err_or_som = $self->prizm_command('NetworkIfService', 'setElementConfigSet', + [ $element ], + $svc->vlan_profile, + 0, + 1, + ); + return $err_or_som + unless ref($err_or_som); + + $err_or_som = $self->prizm_command('NetworkIfService', 'setElementConfigSet', + [ $element ], + $svc->cust_svc->cust_pkg->part_pkg->pkg, + 0, + 1, + ); + return $err_or_som + unless ref($err_or_som); + + $err_or_som = $self->prizm_command('NetworkIfService', + 'activateNetworkElements', + [ $element ], + 1, + ( $self->option('ems') ? 1 : 0 ), + ); + + return $err_or_som + unless ref($err_or_som); + + $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); + + ''; +} + +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); + + ''; + +} + +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 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 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 new file mode 100644 index 000000000..2ac3edb22 --- /dev/null +++ b/FS/FS/part_export/radiator.pm @@ -0,0 +1,167 @@ +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 radusers table to any SQL database in +Radiator-native format. +To setup accounting, see the RADIATOR documentation for hooks to update +a standard radacct 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 new file mode 100644 index 000000000..42aa51cf6 --- /dev/null +++ b/FS/FS/part_export/router.pm @@ -0,0 +1,375 @@ +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/shellcommands.pm b/FS/FS/part_export/shellcommands.pm new file mode 100644 index 000000000..29e0a5799 --- /dev/null +++ b/FS/FS/part_export/shellcommands.pm @@ -0,0 +1,399 @@ +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_stdin' => { label=>'Insert command STDIN', + type =>'textarea', + default=>'', + }, + 'userdel' => { label=>'Delete command', + default=>'userdel -r $username', + #default=>'rm -rf $dir', + }, + '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_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_stdin' => { label=>'Suspension command STDIN', + default=>'', + }, + 'unsuspend' => { label=>'Unsuspension command', + default=>'usermod -U $username', + }, + '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', + }, +; + +%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 +setup SSH for unattended operation. + +

    Use these buttons for some useful presets: +
      +
    • + +
    • + + 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 + FreeBSD PR#23501 + and use the "FreeBSD 4.10 / 5.3 or later" button below. +
    • + +
    • + +
    • + +
    + +The following variables are available for interpolation (prefixed with new_ or +old_ for replace operations): +
      +
    • $username +
    • $_password +
    • $quoted_password - unencrypted password, already quoted for the shell (do not add additional quotes). +
    • $crypt_password - encrypted password. When used on the command line (rather than STDIN), it will be quoted for the shell already (do not add additional quotes). +
    • $ldap_password - 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). +
    • $uid +
    • $gid +
    • $finger - GECOS. When used on the command line (rather than STDIN), it will be quoted for the shell already (do not add additional quotes). +
    • $first - 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). +
    • $last - 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). +
    • $dir - home directory +
    • $shell +
    • $quota +
    • @radius_groups +
    • $reasonnum (when suspending) +
    • $reasontext (when suspending) +
    • $reasontypenum (when suspending) +
    • $reasontypetext (when suspending) +
    • All other fields in svc_acct are also available. +
    +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 ) { + $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) ) { + $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 = ''; + } + + 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; + + my $command_string = eval(qq("$command")); + + $self->shellcommands_queue( $svc_acct->svcnum, + user => $self->option('user')||'root', + host => $self->machine, + command => $command_string, + stdin_string => $stdin_string, + ); +} + +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; + } + $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; + + 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; + + my $command_string = eval(qq("$command")); + + $self->shellcommands_queue( $new->svcnum, + user => $self->option('user')||'root', + host => $self->machine, + command => $command_string, + stdin_string => $stdin_string, + ); +} + +#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 new file mode 100644 index 000000000..7c5d9045f --- /dev/null +++ b/FS/FS/part_export/shellcommands_withdomain.pm @@ -0,0 +1,112 @@ +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", + }, + 'userdel' => { label=>'Delete command', + #default=>'', + }, + 'userdel_stdin' => { label=>'Delete command STDIN', + type =>'textarea', + #default=>'', + }, + 'usermod' => { label=>'Modify command', + default=>'', + }, + 'usermod_stdin' => { label=>'Modify command STDIN', + type =>'textarea', + #default=>"$_password\n$_password\n", + }, + '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=>'', + }, + 'unsuspend' => { label=>'Unsuspension command', + default=>'', + }, + 'unsuspend_stdin' => { label=>'Unsuspension command STDIN', + default=>'', + }, + '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 +setup SSH for unattended operation. + +

    Use these buttons for some useful presets: +
      +
    • +
    • +
    + +The following variables are available for interpolation (prefixed with +new_ or old_ for replace operations): +
      +
    • $username +
    • $domain +
    • $_password +
    • $quoted_password - unencrypted password, already quoted for the shell (do not add additional quotes) +
    • $crypt_password - encrypted password, already quoted for the shell (do not add additional quotes) +
    • $uid +
    • $gid +
    • $finger - GECOS, already quoted for the shell (do not add additional quotes) +
    • $first - First name of GECOS, already quoted for the shell (do not add additional quotes) +
    • $last - Last name of GECOS, already quoted for the shell (do not add additional quotes) +
    • $dir - home directory +
    • $shell +
    • $quota +
    • @radius_groups +
    • All other fields in svc_acct are also available. +
    +END +); + +1; + diff --git a/FS/FS/part_export/snmp.pm b/FS/FS/part_export/snmp.pm new file mode 100644 index 000000000..81b3c7eb2 --- /dev/null +++ b/FS/FS/part_export/snmp.pm @@ -0,0 +1,256 @@ +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 + +=item snmp_cmd_replace - SNMP SETs to perform on replace. See L + +=item snmp_cmd_delete - SNMP SETs to perform on delete. See L + +=item snmp_cmd_suspend - SNMP SETs to perform on suspend. See L + +=item snmp_cmd_unsuspend - SNMP SETs to perform on unsuspend. See L + +=back + +=head1 Formatting + +The values for the snmp_cmd_* fields should be formatted as follows: + +||[||||[...]] + +=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, 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/sqlmail.pm b/FS/FS/part_export/sqlmail.pm new file mode 100644 index 000000000..cbdaf7f52 --- /dev/null +++ b/FS/FS/part_export/sqlmail.pm @@ -0,0 +1,220 @@ +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 new file mode 100644 index 000000000..5e63e1004 --- /dev/null +++ b/FS/FS/part_export/sqlradius.pm @@ -0,0 +1,722 @@ +package FS::part_export::sqlradius; + +use vars qw(@ISA $DEBUG %info %options $notes1 $notes2); +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); + +$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', + }, + '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', } , + '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 radcheck, radreply and usergroup +tables to any SQL database for +FreeRADIUS +or ICRADIUS. +END + +$notes2 = <<'END'; +An existing RADIUS database will be updated in realtime, but you can use +freeside-sqlradius-reset +to delete the entire RADIUS database and repopulate the tables from the +Freeside database. See the +DBI documentation +and the +documentation for your DBD +for the exact syntax of a DBI data source. +
      +
    • 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. +
    • Using ICRADIUS, add a dummy "op" column to your database: +
      + ALTER TABLE radcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='
      + ALTER TABLE radreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='
      + ALTER TABLE radgroupcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='
      + ALTER TABLE radgroupreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '==' +
      +
    • Using Radiator, see the + Radiator FAQ + for configuration information. +
    +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_acct) = (shift, shift); + + foreach my $table (qw(reply check)) { + my $method = "radius_$table"; + my %attrib = $svc_acct->$method(); + next unless keys %attrib; + my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'insert', + $table, $self->export_username($svc_acct), %attrib ); + return $err_or_queue unless ref($err_or_queue); + } + my @groups = $svc_acct->radius_groups; + if ( @groups ) { + cluck localtime(). ": queuing usergroup_insert for ". $svc_acct->svcnum. + " (". $self->export_username($svc_acct). " with ". join(", ", @groups) + if $DEBUG; + my $err_or_queue = $self->sqlradius_queue( + $svc_acct->svcnum, 'usergroup_insert', + $self->export_username($svc_acct), @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 $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename', + $self->export_username($new), $self->export_username($old) ); + 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_acct ) = (shift, shift); + my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'delete', + $self->export_username($svc_acct) ); + 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; + 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 =~ /Password/i ? '==' : ':=' ), + $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, @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; + } + $dbh->disconnect; +} + +sub sqlradius_usergroup_delete { #subroutine, not method + my $dbh = sqlradius_connect(shift, shift, shift); + my( $username, @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) = @_; + 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; + + 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; + } + + if ( @delgroups ) { + my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete', + $username, @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, @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 TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ] + +TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see +L. Also see L and L 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, $start, $end ) = splice(@_, 0, 3); + my $svc_acct = @_ ? shift : ''; + my $ip = @_ ? shift : ''; + my $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 ( $svc_acct =~ /^([^@]+)\@([^@]+)$/ ) { + $where = '( UserName = ? OR ( UserName = ? AND Realm = ? ) ) AND'; + push @param, $username, $1, $2; + } else { + $where = 'UserName = ? AND'; + push @param, $username; + } + } + + if ( length($ip) ) { + $where .= ' FramedIPAddress = ? AND'; + push @param, $ip; + } + + if ( length($prefix) ) { + #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/ + $where .= " CalledStationID LIKE 'sip:$prefix\%' AND"; + } + + push @param, $start, $end; + + my $sth = $dbh->prepare('SELECT '. join(', ', @fields). + " FROM radacct + WHERE $where + $str2time AcctStopTime ) >= ? + AND $str2time AcctStopTime ) <= ? + 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_acct { + 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 @svc_acct = + grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum, + 'svcpart' => $_->cust_svc->svcpart, } ) + } + qsearch( 'svc_acct', + { 'username' => $UserName }, + '', + $extra_sql + ); + + my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ". + "(UserName $UserName, Realm $Realm)"; + my $status = 'skipped'; + 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 { + warn "found svc_acct ". $svc_acct[0]->svcnum. " $errinfo\n" if $DEBUG; + $svc_acct[0]->last_login($AcctStartTime); + $svc_acct[0]->last_logout($AcctStopTime); + my @stati; + push @stati, _try_decrement($svc_acct[0], 'seconds', $AcctSessionTime); + push @stati, _try_decrement($svc_acct[0], 'upbytes', $AcctInputOctets); + push @stati, _try_decrement($svc_acct[0], 'downbytes', $AcctOutputOctets); + push @stati, _try_decrement($svc_acct[0], 'totalbytes', $AcctInputOctets + + $AcctOutputOctets); + $status=join(' ', @stati); + } + + 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'; +} + +1; + diff --git a/FS/FS/part_export/sqlradius_withdomain.pm b/FS/FS/part_export/sqlradius_withdomain.pm new file mode 100644 index 000000000..e5a7151a2 --- /dev/null +++ b/FS/FS/part_export/sqlradius_withdomain.pm @@ -0,0 +1,28 @@ +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 new file mode 100644 index 000000000..244c3bf82 --- /dev/null +++ b/FS/FS/part_export/sysvshell.pm @@ -0,0 +1,25 @@ +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 +Crypt::PasswdMD5 +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 new file mode 100644 index 000000000..3cd7039f8 --- /dev/null +++ b/FS/FS/part_export/textradius.pm @@ -0,0 +1,191 @@ +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 +RADIUS::UserFile +from CPAN. If using RADIUS::UserFile 1.01, make sure to apply +this patch. Also +make sure rsync is installed on the +remote machine, and SSH is setup for unattended +operation. +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/trango.pm b/FS/FS/part_export/trango.pm new file mode 100644 index 000000000..e7f1126dd --- /dev/null +++ b/FS/FS/part_export/trango.pm @@ -0,0 +1,434 @@ +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. + +=item trango_apid - AP ID of the Trango AP. See L. + +=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/vpopmail.pm b/FS/FS/part_export/vpopmail.pm new file mode 100644 index 000000000..4cda65755 --- /dev/null +++ b/FS/FS/part_export/vpopmail.pm @@ -0,0 +1,254 @@ +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.
    +
    +Real time export to vpopmail text +files. File::Rsync +must be installed, and you will need to +setup SSH for unattended operation +to vpopmail@export.host. +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 () { + 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 () { + 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 new file mode 100644 index 000000000..82d555761 --- /dev/null +++ b/FS/FS/part_export/www_plesk.pm @@ -0,0 +1,138 @@ +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 +Plesk managed server. +Requires installation of +Net::Plesk +from CPAN. +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 new file mode 100644 index 000000000..7e4be9ce4 --- /dev/null +++ b/FS/FS/part_export/www_shellcommands.pm @@ -0,0 +1,190 @@ +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 +setup SSH for unattended operation. +

    Use these buttons for some useful presets: +
      +
    • + +
    • + +
    • +
    +The following variables are available for interpolation (prefixed with +new_ or old_ for replace operations): +
      +
    • $zone - fully-qualified zone of this virtual host +
    • $bare_zone - just the zone of this virtual host, without the domain portion +
    • $domain - base domain +
    • $username +
    • $_password +
    • $homedir +
    • All other fields in svc_www + are also available. +
    +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 new file mode 100644 index 000000000..e75940429 --- /dev/null +++ b/FS/FS/part_export_option.pm @@ -0,0 +1,134 @@ +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) + +=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 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, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm new file mode 100644 index 000000000..84502b745 --- /dev/null +++ b/FS/FS/part_pkg.pm @@ -0,0 +1,896 @@ +package FS::part_pkg; + +use strict; +use vars qw( @ISA %plans $DEBUG ); +use Carp qw(carp cluck confess); +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; + +@ISA = qw( FS::m2m_Common FS::Record ); # FS::option_Common ); # this can use option_Common + # when all the plandata bs is + # gone + +$DEBUG = 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) + +=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 instead) + +=item disabled - Disabled flag, empty or `Y' + +=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) + +=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 `(CUSTOM) ' is prepended +to the comment field. 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{'comment'} = "(CUSTOM) ". $hash{'comment'} + unless $hash{'comment'} =~ /^\(CUSTOM\) /; + #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, I, I, +I and I. + +If I is set to a hashref with svcparts as keys and quantities as +values, appropriate FS::pkg_svc records will be inserted. + +If I is set to the svcpart of the primary service, the appropriate +FS::pkg_svc record will be updated. + +If I 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, if I is set to a scalar reference, +the scalar will be updated with the custnum value from the cust_pkg record. + +If I 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 " saving legacy plandata" if $DEBUG; + my $plandata = $self->get('plandata'); + $self->set('plandata', ''); + + warn " inserting part_pkg record" if $DEBUG; + my $error = $self->SUPER::insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + if ( $plandata ) { + + warn " inserting part_pkg_option records for 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' => $self->pkgpart, + 'optionname' => $1, + 'optionvalue' => $2, + }; + } + split("\n", $plandata) + ) { + my $error = $part_pkg_option->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + } elsif ( $options{'options'} ) { + + warn " inserting part_pkg_option records for options hashref" if $DEBUG; + foreach my $optionname ( keys %{$options{'options'}} ) { + + my $part_pkg_option = + new FS::part_pkg_option { + 'pkgpart' => $self->pkgpart, + 'optionname' => $optionname, + 'optionvalue' => $options{'options'}->{$optionname}, + }; + + my $error = $part_pkg_option->insert; + 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 pkg_svc records" if $DEBUG; + my $pkg_svc = $options{'pkg_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, + } ); + 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"; + } + } + + 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 and I + +If I is set to a hashref with svcparts as keys and quantities as +values, the appropriate FS::pkg_svc records will be replace. + +If I is set to the svcpart of the primary service, the appropriate +FS::pkg_svc record will be updated. + +=cut + +sub replace { + my( $new, $old ) = ( shift, shift ); + my %options = @_; + + # We absolutely have to have an old vs. new record to make this work. + if (!defined($old)) { + $old = qsearchs( 'part_pkg', { 'pkgpart' => $new->pkgpart } ); + } + + warn "FS::part_pkg::replace called on $new to replace $old ". + "with options %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 " 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); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + warn " inserting part_pkg_option records for 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'} || {}; + foreach my $part_svc ( qsearch('part_svc', {} ) ) { + my $quantity = $pkg_svc->{$part_svc->svcpart} || 0; + my $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 = $old_pkg_svc ? $old_pkg_svc->quantity : 0; + my $old_primary_svc = + ( $old_pkg_svc && $old_pkg_svc->dbdef_table->column('primary_svc') ) + ? $old_pkg_svc->primary_svc + : ''; + next unless $old_quantity != $quantity || $old_primary_svc ne $primary_svc; + + 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, + } ); + my $error = $old_pkg_svc + ? $new_pkg_svc->replace($old_pkg_svc) + : $new_pkg_svc->insert; + 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 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" + 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 $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_floatn('pay_weight') + || $self->ut_floatn('credit_weight') + || $self->ut_agentnum_acl('agentnum', 'Edit global package definitions') + || $self->SUPER::check + ; + return $error if $error; + + if ( $self->classnum !~ /^$/ ) { + my $error = $self->ut_foreign_key('classnum', 'pkg_class', 'classnum'); + return $error if $error; + } else { + $self->classnum(''); + } + + 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_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 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 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 + +Returns all FS::pkg_svc objects (see L) for this package +definition (with non-zero quantity). + +=cut + +sub pkg_svc { + my $self = shift; + #sort { $b->primary cmp $a->primary } + grep { $_->quantity } + qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } ); +} + +=item svcpart [ SVCDB ] + +Returns the svcpart of the primary service definition (see L) +associated with this package definition (see L). 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, + +=cut + +sub svcpart { + my $self = shift; + my $svcdb = scalar(@_) ? shift : ''; + my @svcdb_pkg_svc = + grep { ( $svcdb eq $_->part_svc->svcdb || !$svcdb ) } $self->pkg_svc; + my @pkg_svc = (); + @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc + if dbdef->table('pkg_svc')->column('primary_svc'); + @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc + unless @pkg_svc; + return '' if scalar(@pkg_svc) != 1; + $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 is +returned, otherwise, the single item B 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 freqs_href { + #method, class method or sub? #my $self = shift; + + 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 freq_pretty + +Returns an english representation of the I 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 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_option + +Returns all options as FS::part_pkg_option objects (see +L). + +=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 + +Returns the option value for the given name, or the empty string. + +=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 _rebless + +Reblesses the object into the FS::part_pkg::PLAN class (if available), where +PLAN is the object's I field. There should be better docs +on how to create new price plans, but until then, see L. + +=cut + +sub _rebless { + my $self = shift; + my $plan = $self->plan; + unless ( $plan ) { + confess "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; } + +=back + +=head1 SUBROUTINES + +=over 4 + +=item plan_info + +=cut + +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" + unless $mod =~ /^(passwdfile|null)$/; #hack but what the heck + 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; + } +} + +tie %plans, 'Tie::IxHash', + map { $_ => $info{$_} } + sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} } + keys %info; + +sub plan_info { + \%plans; +} + +=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 + +=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 + +=head1 SEE ALSO + +L, L, L, L, L. +schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_pkg/base_delayed.pm b/FS/FS/part_pkg/base_delayed.pm new file mode 100644 index 000000000..ddd4caf73 --- /dev/null +++ b/FS/FS/part_pkg/base_delayed.pm @@ -0,0 +1,51 @@ +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)', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'free_days' => { 'name' => 'Initial free days', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Recurring base fee for this package', + 'default' => 0, + }, + 'recur_notify' => { 'name' => 'Number of days before recurring billing'. + 'commences to notify customer. (0 means '. + 'no warning)', + 'default' => 0, + }, + 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. + ' of service at cancellation', + 'type' => 'checkbox', + }, + }, + 'fieldorder' => [ 'free_days', 'setup_fee', 'recur_fee', 'recur_notify', + 'unused_credit' + ], + #'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' => 50, +); + +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 new file mode 100644 index 000000000..04896e0fd --- /dev/null +++ b/FS/FS/part_pkg/base_rate.pm @@ -0,0 +1,93 @@ +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)', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Recurring Base fee for this package', + 'default' => 0, + }, + 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. + ' of service at cancellation', + 'type' => 'checkbox', + }, + 'externalid' => { 'name' => 'Optional External ID', + 'default' => '', + }, + }, + 'fieldorder' => [ 'setup_fee', 'recur_fee', 'unused_credit', + '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++ ); + } + + $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) = @_; + my $time = time; #should be able to pass this in for credit calculation + my $next_bill = $cust_pkg->getfield('bill') || 0; + my $last_bill = $cust_pkg->last_bill || 0; + return 0 if ! $self->base_recur + || ! $self->option('unused_credit', 1) + || ! $last_bill + || ! $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 * ( $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 new file mode 100644 index 000000000..44645b7f9 --- /dev/null +++ b/FS/FS/part_pkg/bulk.pm @@ -0,0 +1,96 @@ +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', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for the entire bulk package', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Recurring fee for the entire bulk package', + 'default' => 0, + }, + 'svc_setup_fee' => { 'name' => 'Setup fee for each new service', + 'default' => 0, + }, + 'svc_recur_fee' => { 'name' => 'Recurring fee for each service', + 'default' => 0, + }, + 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. + ' of service at cancellation', + 'type' => 'checkbox', + }, + }, + 'fieldorder' => [ 'setup_fee', 'recur_fee', 'svc_setup_fee', 'svc_recur_fee', + 'unused_credit', ], + 'weight' => 55, +); + +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; + + my $total_svc_charge = 0; + + warn "$me billing for bulk services from ". time2str('%x', $last_bill). + " to ". time2str('%x', $$sdate). "\n" + if $DEBUG; + + # END START + foreach my $h_svc ( $cust_pkg->h_cust_svc( $$sdate, $last_bill ) ) { + + my @label = $h_svc->label( $$sdate, $last_bill ); + die "fatal: no historical label found, wtf?" unless scalar(@label); #? + #my $svc_details = $label[0].': '. $label[1]. ': '; + my $svc_details = $label[1]. ': '; + + my $svc_charge = 0; + + my $svc_start = $h_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); + } + + my $svc_end = $h_svc->date_deleted; + $svc_end = ( !$svc_end || $svc_end > $$sdate ) ? $$sdate : $svc_end; + + $svc_charge = $self->option('svc_recur_fee') * ( $svc_end - $svc_start ) + / ( $$sdate - $last_bill ); + + $svc_details .= $money_char. sprintf('%.2f', $svc_charge ). + ' ('. time2str('%x', $svc_start). + ' - '. time2str('%x', $svc_end ). ')' + if $self->option('svc_recur_fee'); + + push @$details, $svc_details; + $total_svc_charge += $svc_charge; + + } + + sprintf("%.2f", $self->base_recur($cust_pkg) + $total_svc_charge ); +} + +sub is_free_options { + qw( setup_fee recur_fee svc_setup_fee svc_recur_fee ); +} + +1; + diff --git a/FS/FS/part_pkg/flat.pm b/FS/FS/part_pkg/flat.pm new file mode 100644 index 000000000..92e72cf8a --- /dev/null +++ b/FS/FS/part_pkg/flat.pm @@ -0,0 +1,168 @@ +package FS::part_pkg::flat; + +use strict; +use vars qw(@ISA %info); +#use FS::Record qw(qsearch); +use FS::UI::bytecount; +use FS::part_pkg; + +@ISA = qw(FS::part_pkg); + +%info = ( + 'name' => 'Flat rate (anniversary billing)', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Recurring fee for this package', + 'default' => 0, + }, + 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. + ' of service at cancellation', + 'type' => 'checkbox', + }, + 'externalid' => { 'name' => 'Optional External ID', + 'default' => '', + }, + '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' => [ 'setup_fee', 'recur_fee', 'unused_credit', + 'seconds', 'upbytes', 'downbytes', 'totalbytes', + 'recharge_amount', 'recharge_seconds', 'recharge_upbytes', + 'recharge_downbytes', 'recharge_totalbytes', + 'usage_rollover', 'recharge_reset', '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++ ); + } + + $self->option('setup_fee'); +} + +sub calc_recur { + my($self, $cust_pkg) = @_; + $self->base_recur($cust_pkg); +} + +sub base_recur { + my($self, $cust_pkg) = @_; + $self->option('recur_fee', 1) || 0; +} + +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; + my $last_bill = $cust_pkg->last_bill || 0; + return 0 if ! $self->base_recur + || ! $self->option('unused_credit', 1) + || ! $last_bill + || ! $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 * ( $next_bill - $time ) / $freq_sec ); + +} + +sub is_free_options { + qw( setup_fee recur_fee ); +} + +sub is_prepaid { + 0; #no, we're postpaid +} + +sub reset_usage { + my($self, $cust_pkg) = @_; + my %values = map { $_, $self->option($_) } + grep { $self->option($_, 'hush') } + qw(seconds upbytes downbytes totalbytes); + if ($self->option('usage_rollover', 1)) { + $cust_pkg->recharge(\%values); + }else{ + $cust_pkg->set_usage(\%values); + } +} + +1; diff --git a/FS/FS/part_pkg/flat_comission.pm b/FS/FS/part_pkg/flat_comission.pm new file mode 100644 index 000000000..4592bedef --- /dev/null +++ b/FS/FS/part_pkg/flat_comission.pm @@ -0,0 +1,66 @@ +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', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Recurring fee for this package', + 'default' => 0, + }, + 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. + ' of service at cancellation', + 'type' => 'checkbox', + }, + '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' => [ 'setup_fee', 'recur_fee', 'unused_credit', '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'); +} + +1; diff --git a/FS/FS/part_pkg/flat_comission_cust.pm b/FS/FS/part_pkg/flat_comission_cust.pm new file mode 100644 index 000000000..82e5111e8 --- /dev/null +++ b/FS/FS/part_pkg/flat_comission_cust.pm @@ -0,0 +1,64 @@ +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', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Recurring fee for this package', + 'default' => 0, + }, + 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. + ' of service at cancellation', + 'type' => 'checkbox', + }, + 'comission_amount' => { 'name' => 'Commission amount per month (per active customer)', + 'default' => 0, + }, + 'comission_depth' => { 'name' => 'Number of layers', + 'default' => 1, + }, + 'reason_type' => { 'name' => 'Reason type for commission credits', + 'type' => 'select_table', + 'select_table' => 'reason_type', + 'select_hash' => { 'class' => 'R' }, + 'select_key' => 'typenum', + 'select_label' => 'type', + }, + }, + 'fieldorder' => [ 'setup_fee', 'recur_fee', 'unused_credit', '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_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'); +} + +1; diff --git a/FS/FS/part_pkg/flat_comission_pkg.pm b/FS/FS/part_pkg/flat_comission_pkg.pm new file mode 100644 index 000000000..07c3d1b9a --- /dev/null +++ b/FS/FS/part_pkg/flat_comission_pkg.pm @@ -0,0 +1,57 @@ +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', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Recurring fee for this package', + 'default' => 0, + }, + 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. + ' of service at cancellation', + 'type' => 'checkbox', + }, + 'comission_amount' => { 'name' => 'Commission amount per month (per uncancelled package)', + 'default' => 0, + }, + 'comission_depth' => { 'name' => 'Number of layers', + 'default' => 1, + }, + 'comission_pkgpart' => { 'name' => 'Applicable packages
    (hold ctrl to select multiple packages)', + 'type' => 'select_multiple', + 'select_table' => 'part_pkg', + 'select_hash' => { 'disabled' => '' } , + 'select_key' => 'pkgpart', + 'select_label' => 'pkg', + }, + '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' => [ 'setup_fee', 'recur_fee', 'unused_credit', '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'); +} + +1; diff --git a/FS/FS/part_pkg/flat_delayed.pm b/FS/FS/part_pkg/flat_delayed.pm new file mode 100644 index 000000000..8ac168280 --- /dev/null +++ b/FS/FS/part_pkg/flat_delayed.pm @@ -0,0 +1,68 @@ +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)', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'free_days' => { 'name' => 'Initial free days', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Recurring fee for this package', + 'default' => 0, + }, + 'recur_notify' => { 'name' => 'Number of days before recurring billing'. + 'commences to notify customer. (0 means '. + 'no warning)', + 'default' => 0, + }, + 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. + ' of service at cancellation', + 'type' => 'checkbox', + }, + }, + 'fieldorder' => [ 'free_days', 'setup_fee', 'recur_fee', 'recur_notify', + 'unused_credit' + ], + #'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' => 50, +); + +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 0 if ! $self->base_recur + || ! $self->option('unused_credit', 1) + || ! $last_bill + || ! $next_bill; + + 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 new file mode 100644 index 000000000..c92ba978a --- /dev/null +++ b/FS/FS/part_pkg/flat_introrate.pm @@ -0,0 +1,67 @@ +package FS::part_pkg::flat_introrate; + +use strict; +use vars qw(@ISA %info $DEBUG $DEBUG_PRE); +#use FS::Record qw(qsearch qsearchs); +use FS::part_pkg::flat; + +use Date::Manip qw(DateCalc UnixDate ParseDate); + +@ISA = qw(FS::part_pkg::flat); +$DEBUG = 0; +$DEBUG_PRE = '[' . __PACKAGE__ . ']: '; + +%info = ( + 'name' => 'Introductory price for X months, then flat rate,'. + 'relative to setup date (anniversary billing)', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'intro_fee' => { 'name' => 'Introductory recurring free for this package', + 'default' => 0, + }, + 'intro_duration' => { 'name' => 'Duration of the introductory period, ' . + 'in number of months', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Recurring fee for this package', + 'default' => 0, + }, + 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. + ' of service at cancellation', + 'type' => 'checkbox', + }, + }, + 'fieldorder' => [ 'setup_fee', 'intro_duration', 'intro_fee', 'recur_fee', 'unused_credit' ], + 'weight' => 150, +); + +sub calc_recur { + my($self, $cust_pkg, $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 $DEBUG_PRE . "\$duration = ${duration}" if $DEBUG; + warn $DEBUG_PRE . "\$intro_end = ${intro_end}" if $DEBUG; + warn $DEBUG_PRE . "$$time < " . &UnixDate($intro_end, '%s') if $DEBUG; + + if ($$time < &UnixDate($intro_end, '%s')) { + $recur = $self->option('intro_fee'); + } else { + $recur = $self->option('recur_fee'); + } + + $recur; + +} + + +1; diff --git a/FS/FS/part_pkg/incomplete/billoneday.pm b/FS/FS/part_pkg/incomplete/billoneday.pm new file mode 100644 index 000000000..8740547a3 --- /dev/null +++ b/FS/FS/part_pkg/incomplete/billoneday.pm @@ -0,0 +1,48 @@ +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 new file mode 100644 index 000000000..d309d453f --- /dev/null +++ b/FS/FS/part_pkg/prepaid.pm @@ -0,0 +1,38 @@ +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', +; + +%info = ( + 'name' => 'Prepaid, flat rate', + 'fields' => { + 'setup_fee' => { 'name' => 'One-time setup fee for this package', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Initial and recharge fee for this package', + 'default' => 0, + }, + 'recur_action' => { 'name' => 'Action to take upon reaching end of prepaid preiod', + 'type' => 'select', + 'select_options' => \%recur_action, + }, + }, + 'fieldorder' => [ 'setup_fee', 'recur_fee', 'recur_action', ], + 'weight' => 25, +); + +sub is_prepaid { + 1; +} + +1; + diff --git a/FS/FS/part_pkg/prorate.pm b/FS/FS/part_pkg/prorate.pm new file mode 100644 index 000000000..45bbf0153 --- /dev/null +++ b/FS/FS/part_pkg/prorate.pm @@ -0,0 +1,122 @@ +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)', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Recurring fee for this package', + 'default' => 0, + }, + 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. + ' of service at cancellation', + 'type' => 'checkbox', + }, + 'cutoff_day' => { 'name' => 'Billing Day (1 - 28)', + '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' => [ 'setup_fee', 'recur_fee', 'unused_credit', 'cutoff_day', + 'seconds', 'upbyte', 'downbytes', 'totalbytes', + 'recharge_amount', 'recharge_seconds', 'recharge_upbytes', + 'recharge_downbytes', 'recharge_totalbytes', + 'usage_rollover', 'recharge_reset', 'externalid', ], + 'freq' => 'm', + 'weight' => 20, +); + +sub calc_recur { + my($self, $cust_pkg, $sdate ) = @_; + 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]; + my $mend; + my $mstart; + + 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); + if ($mon==0) {$mon=11;$year--;} else {$mon--;} + $mstart= timelocal(0,0,0,$cutoff_day,$mon,$year); + } + + $$sdate = $mstart; + my $permonth = $self->option('recur_fee') / $self->freq; + + $permonth * ( ( $self->freq - 1 ) + ($mend-$mnow) / ($mend-$mstart) ); +} + +1; diff --git a/FS/FS/part_pkg/prorate_delayed.pm b/FS/FS/part_pkg/prorate_delayed.pm new file mode 100644 index 000000000..ee664327e --- /dev/null +++ b/FS/FS/part_pkg/prorate_delayed.pm @@ -0,0 +1,61 @@ +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)', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'free_days' => { 'name' => 'Initial free days', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Recurring fee for this package', + 'default' => 0, + }, + 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. + ' of service at cancellation', + 'type' => 'checkbox', + }, + }, + 'fieldorder' => [ 'free_days', 'setup_fee', 'recur_fee', 'unused_credit' ], + #'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' => 50, +); + +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 0 if ! $self->base_recur + || ! $self->option('unused_credit', 1) + || ! $last_bill + || ! $next_bill; + + return $self->SUPER::calc_remain($cust_pkg, %options); +} + +1; diff --git a/FS/FS/part_pkg/sesmon_hour.pm b/FS/FS/part_pkg/sesmon_hour.pm new file mode 100644 index 000000000..9843edbec --- /dev/null +++ b/FS/FS/part_pkg/sesmon_hour.pm @@ -0,0 +1,56 @@ +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', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_flat' => { 'name' => 'Base recurring fee for this package', + 'default' => 0, + }, + 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. + ' of service at cancellation', + 'type' => 'checkbox', + }, + 'recur_included_hours' => { 'name' => 'Hours included', + 'default' => 0, + }, + 'recur_hourly_charge' => { 'name' => 'Additional charge per hour', + 'default' => 0, + }, + }, + 'fieldorder' => [ 'setup_fee', 'recur_flat', 'unused_credit', '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_flat.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_flat') + $hours * $self->option('recur_hourly_charge'); + +} + +sub is_free_options { + qw( setup_fee recur_fee recur_hourly_charge ); +} + +sub base_recur { + my($self, $cust_pkg) = @_; + $self->option('recur_flat'); +} + +1; diff --git a/FS/FS/part_pkg/sesmon_minute.pm b/FS/FS/part_pkg/sesmon_minute.pm new file mode 100644 index 000000000..39516f8b3 --- /dev/null +++ b/FS/FS/part_pkg/sesmon_minute.pm @@ -0,0 +1,55 @@ +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', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_flat' => { 'name' => 'Base recurring fee for this package', + 'default' => 0, + }, + 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. + ' of service at cancellation', + 'type' => 'checkbox', + }, + 'recur_included_min' => { 'name' => 'Minutes included', + 'default' => 0, + }, + 'recur_minly_charge' => { 'name' => 'Additional charge per minute', + 'default' => 0, + }, + }, + 'fieldorder' => [ 'setup_fee', 'recur_flat', 'unused_credit', '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_flat.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_flat') + $min * $self->option('recur_minly_charge'); +} + +sub is_free_options { + qw( setup_fee recur_fee recur_minly_charge ); +} + +sub base_recur { + my($self, $cust_pkg) = @_; + $self->option('recur_flat'); +} + +1; diff --git a/FS/FS/part_pkg/sql_external.pm b/FS/FS/part_pkg/sql_external.pm new file mode 100644 index 000000000..ca58c4e66 --- /dev/null +++ b/FS/FS/part_pkg/sql_external.pm @@ -0,0 +1,76 @@ +package FS::part_pkg::sql_external; + +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 additional fees for external services from a configurable SQL query', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_flat' => { 'name' => 'Base recurring fee for this package', + 'default' => 0, + }, + 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. + ' of service at cancellation', + 'type' => 'checkbox', + }, + '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( setup_fee recur_flat unused_credit datasrc db_username db_password query )], + #'setup' => 'what.setup_fee.value', + #'recur' => q!'my $dbh = DBI->connect("' + what.datasrc.value + '", "' + what.db_username.value + '", "' + what.db_password.value + '" ) or die $DBI::errstr; my $sth = $dbh->prepare("' + what.query.value + '") or die $dbh->errstr; my $price = ' + what.recur_flat.value + '; foreach my $cust_svc ( grep { $_->part_svc->svcdb eq "svc_external" } $cust_pkg->cust_svc ){ my $id = $cust_svc->svc_x->id; $sth->execute($id) or die $sth->errstr; $price += $sth->fetchrow_arrayref->[0]; } $price;'!, + 'weight' => '72', +); + +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 $price = $self->option('recur_flat'); + + 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 is_free { + 0; +} + +sub base_recur { + my($self, $cust_pkg) = @_; + $self->option('recur_flat'); +} + +1; diff --git a/FS/FS/part_pkg/sql_generic.pm b/FS/FS/part_pkg/sql_generic.pm new file mode 100644 index 000000000..0e6ab7c0d --- /dev/null +++ b/FS/FS/part_pkg/sql_generic.pm @@ -0,0 +1,87 @@ +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', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_flat' => { 'name' => 'Base recurring fee for this package', + 'default' => 0, + }, + 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. + ' of service at cancellation', + 'type' => 'checkbox', + }, + '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( setup_fee recur_flat unused_credit 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_flat.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_flat.value + \' + $units * \' + what.recur_unit_charge + \';\'', + 'weight' => '70', +); + +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_flat') + $units * $self->option('recur_unit_charge'); +} + +sub is_free_options { + qw( setup_fee recur_flat recur_unit_charge ); +} + +sub base_recur { + my($self, $cust_pkg) = @_; + $self->option('recur_flat'); +} + +1; diff --git a/FS/FS/part_pkg/sqlradacct_hour.pm b/FS/FS/part_pkg/sqlradacct_hour.pm new file mode 100644 index 000000000..e54a8a553 --- /dev/null +++ b/FS/FS/part_pkg/sqlradacct_hour.pm @@ -0,0 +1,170 @@ +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', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_flat' => { 'name' => 'Base recurring fee for this package', + 'default' => 0, + }, + 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. + ' of service at cancellation', + 'type' => 'checkbox', + }, + + '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( setup_fee recur_flat unused_credit 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_flat.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_hours_cap') + if $self->option('recur_hours_cap') + && $hourscharge > $self->option('recur_hours_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_flat') + $charges; +} + +sub is_free_options { + qw( setup_fee recur_flat recur_hourly_charge + recur_input_charge recur_output_charge recur_total_charge ); +} + +sub base_recur { + my($self, $cust_pkg) = @_; + $self->option('recur_flat'); +} + +1; diff --git a/FS/FS/part_pkg/subscription.pm b/FS/FS/part_pkg/subscription.pm new file mode 100644 index 000000000..c9c472c2d --- /dev/null +++ b/FS/FS/part_pkg/subscription.pm @@ -0,0 +1,108 @@ +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)', + '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, + }, + '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' => [ 'setup_fee', 'recur_fee', '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 ) = @_; + 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); + + $self->option('recur_fee'); +} + +1; diff --git a/FS/FS/part_pkg/voip_cdr.pm b/FS/FS/part_pkg/voip_cdr.pm new file mode 100644 index 000000000..7cf177972 --- /dev/null +++ b/FS/FS/part_pkg/voip_cdr.pm @@ -0,0 +1,357 @@ +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::flat; +#use FS::rate; +#use FS::rate_prefix; + +@ISA = qw(FS::part_pkg::flat); + +$DEBUG = 1; + +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.', +; + +#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', +#; + +%info = ( + 'name' => 'VoIP rating by plan of CDR records in an internal (or external?) SQL table', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_flat' => { 'name' => 'Base recurring fee for this package', + 'default' => 0, + }, + 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. + ' of service at cancellation', + 'type' => 'checkbox', + }, + 'ratenum' => { 'name' => 'Rate plan', + 'type' => 'select', + 'select_table' => 'rate', + 'select_key' => 'ratenum', + 'select_label' => 'ratename', + }, + 'rating_method' => { 'name' => 'Region rating method', + 'type' => 'select', + 'select_options' => \%rating_method, + }, + + 'default_prefix' => { 'name' => 'Default prefix optionally prepended to customer DID numbers when searching for CDR records', + 'default' => '+1', + }, + + #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( setup_fee recur_flat unused_credit ratenum rating_method default_prefix )], + 'weight' => 40, +); + +sub calc_setup { + my($self, $cust_pkg ) = @_; + $self->option('setup_fee'); +} + +#false laziness w/voip_sqlradacct... resolve it if that one ever gets used again +sub calc_recur { + my($self, $cust_pkg, $sdate, $details, $param ) = @_; + + my $last_bill = $cust_pkg->last_bill; + + 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 = ''; + + foreach my $cust_svc ( + grep { $_->part_svc->svcdb eq 'svc_phone' } $cust_pkg->cust_svc + ) { + + foreach my $cdr ( + $cust_svc->get_cdrs_for_update() # $last_bill, $$sdate ) + ) { + if ( $DEBUG > 1 ) { + warn "rating CDR $cdr\n". + join('', map { " $_ => ". $cdr->{$_}. "\n" } keys %$cdr ); + } + + my $rate_detail; + my( $rate_region, $regionnum ); + my $pretty_destnum; + my $charge = 0; + my @call_details = (); + if ( $self->option('rating_method') eq 'prefix' + || ! $self->option('rating_method') + ) + { + + ### + # look up rate details based on called station id + # (or calling station id for toll free calls) + ### + + my( $to_or_from, $number ); + if ( $cdr->dst =~ /^(\+?1)?8([02-8])\1/ ) { #tollfree call + $to_or_from = 'from'; + $number = $cdr->src; + } else { #regular call + $to_or_from = 'to'; + $number = $cdr->dst; + } + + #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 + my $countrycode; + if ( $number =~ /^011(((\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 = '1'; + $number =~ s/^1//;# if length($number) > 10; + } + + warn "rating call $to_or_from +$countrycode $number\n" if $DEBUG; + $pretty_destnum = "+$countrycode $number"; + + #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($number, 0, $len) } + 'npa' => substr($number, 0, $len), + } ) and last; + } + $rate_prefix ||= qsearchs('rate_prefix', { + 'countrycode' => $countrycode, + 'npa' => '', + }); + + # + die "Can't find rate for call $to_or_from +$countrycode $\numbern" + unless $rate_prefix; + + $regionnum = $rate_prefix->regionnum; + $rate_detail = qsearchs('rate_detail', { + 'ratenum' => $ratenum, + 'dest_regionnum' => $regionnum, + } ); + + $rate_region = $rate_prefix->rate_region; + + warn " found rate for regionnum $regionnum ". + "and rate detail $rate_detail\n" + if $DEBUG; + + } elsif ( $self->option('rating_method') eq 'upstream' ) { + + if ( $cdr->cdrtypenum == 1 ) { #rate based on upstream rateid + + $rate_detail = $cdr->cdr_upstream_rate->rate_detail; + + $regionnum = $rate_detail->dest_regionnum; + $rate_region = $rate_detail->dest_region; + + $pretty_destnum = $cdr->dst; + + warn " found rate for regionnum $regionnum and ". + "rate detail $rate_detail\n" + if $DEBUG; + + } else { #pass upstream price through + + $charge = sprintf('%.2f', $cdr->upstream_price); + + @call_details = ( + #time2str("%Y %b %d - %r", $cdr->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 + 'N/A', #minutes... + '$'.$charge, + #$pretty_destnum, + $cdr->description, #$rate_region->regionname, + ); + + } + + } else { + die "don't know how to rate CDRs using method: ". + $self->option('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 NULL, + # don't call downstream_csv or something on it... + # but DO emit a warning... + if ( ! $rate_detail && ! scalar(@call_details) ) { + + warn "no rate_detail found for CDR.acctid: ". $cdr->acctid. + "; skipping\n" + + } else { # there *is* a rate_detail (or call_details), proceed... + + unless ( @call_details ) { + + $included_min{$regionnum} = $rate_detail->min_included + unless exists $included_min{$regionnum}; + + my $granularity = $rate_detail->sec_granularity; + my $seconds = $cdr->billsec; # |ength($cdr->billsec) ? $cdr->billsec : $cdr->duration; + $seconds += $granularity - ( $seconds % $granularity ) + if $granularity; # 0 is per call + my $minutes = sprintf("%.1f", $seconds / 60); + $minutes =~ s/\.0$// if $granularity == 60; + + # per call rather than per minute + $minutes = 1 unless $granularity; + + $included_min{$regionnum} -= $minutes; + + 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; + } + + # this is why we need regionnum/rate_region.... + warn " (rate region $rate_region)\n" if $DEBUG; + + @call_details = ( + #time2str("%Y %b %d - %r", $cdr->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 + $granularity ? $minutes.'m' : $minutes.' call', + '$'.$charge, + $pretty_destnum, + $rate_region->regionname, + ); + + } + + warn " adding details on charge to invoice: ". + join(' - ', @call_details ) + if $DEBUG; + + push @$details, join(' - ', @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' => 'convergent' ) + if $spool_cdr; + + my $error = $cdr->set_status_and_rated_price('done', $charge); + die $error if $error; + + } + + } # $cdr + + } # $cust_svc + + 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) ) + + $self->option('recur_flat') + $charges; + +} + +sub is_free { + 0; +} + +sub base_recur { + my($self, $cust_pkg) = @_; + $self->option('recur_flat'); +} + +1; + diff --git a/FS/FS/part_pkg/voip_sqlradacct.pm b/FS/FS/part_pkg/voip_sqlradacct.pm new file mode 100644 index 000000000..bf18003ab --- /dev/null +++ b/FS/FS/part_pkg/voip_sqlradacct.pm @@ -0,0 +1,192 @@ +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 = ( + 'name' => 'VoIP rating by plan of CDR records in an SQL RADIUS radacct table', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_flat' => { 'name' => 'Base recurring fee for this package', + 'default' => 0, + }, + 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. + ' of service at cancellation', + 'type' => 'checkbox', + }, + 'ratenum' => { 'name' => 'Rate plan', + 'type' => 'select', + 'select_table' => 'rate', + 'select_key' => 'ratenum', + 'select_label' => 'ratename', + }, + }, + 'fieldorder' => [qw( setup_fee recur_flat unused_credit 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_flat') + $charges; + +} + +sub is_free { + 0; +} + +sub base_recur { + my($self, $cust_pkg) = @_; + $self->option('recur_flat'); +} + +1; + diff --git a/FS/FS/part_pkg_option.pm b/FS/FS/part_pkg_option.pm new file mode 100644 index 000000000..c2f609e1b --- /dev/null +++ b/FS/FS/part_pkg_option.pm @@ -0,0 +1,131 @@ +package FS::part_pkg_option; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs ); +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) + +=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 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 + +=head1 BUGS + +Possibly. + +=head1 SEE ALSO + +L, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_pkg_taxclass.pm b/FS/FS/part_pkg_taxclass.pm new file mode 100644 index 000000000..fda200ee9 --- /dev/null +++ b/FS/FS/part_pkg_taxclass.pm @@ -0,0 +1,158 @@ +package FS::part_pkg_taxclass; + +use strict; +use vars qw( @ISA ); +use FS::UID qw(dbh); +use FS::Record qw( qsearch qsearchs ); + +@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 + +=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 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 + +# 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 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') + ; + 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, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_pop_local.pm b/FS/FS/part_pop_local.pm new file mode 100644 index 000000000..01c59df93 --- /dev/null +++ b/FS/FS/part_pop_local.pm @@ -0,0 +1,113 @@ +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) 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 + +=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, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_referral.pm b/FS/FS/part_referral.pm new file mode 100644 index 000000000..87bc87cba --- /dev/null +++ b/FS/FS/part_referral.pm @@ -0,0 +1,204 @@ +package FS::part_referral; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs dbh ); +use FS::agent; + +@ISA = qw( FS::Record ); + +=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) + +=back + +=head1 NOTE + +These were called B 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') + || $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, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm new file mode 100644 index 000000000..4fae457e2 --- /dev/null +++ b/FS/FS/part_svc.pm @@ -0,0 +1,825 @@ +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, +L, and L, 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). + +=over 4 + +=item I__I - Default or fixed value for I in I. + +=item I__I_flag - defines I__I 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 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') ) + } (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'); + #if ( uc($flag) =~ /^([DFMAX])$/ ) { + if ( uc($flag) =~ /^([A-Z])$/ ) { #part_svc_column will test it + 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)) + ); + 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') ) + } (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'); + #if ( uc($flag) =~ /^([DFMAX])$/ ) { + if ( uc($flag) =~ /^([A-Z])$/ ) { #part_svc_column will test it + 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($new->getfield($svcdb.'__'.$field)) + ); + 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) 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) 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) 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 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). 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). 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'}; + + 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 { + if ( $param->{ $svcdb.'__'.$_.'_flag' } =~ /^[MA]$/ ) { + $param->{ $svcdb.'__'.$_ } = + delete( $param->{ $svcdb.'__'.$_.'_classnum' } ); + } + if ( $param->{ $svcdb.'__'.$_.'_flag' } =~ /^S$/ ) { + $param->{ $svcdb.'__'.$_} = + ref($param->{ $svcdb.'__'.$_}) + ? join(',', @{$param->{ $svcdb.'__'.$_ }} ) + : $param->{ $svcdb.'__'.$_ }; + } + ( $svcdb.'__'.$_, $svcdb.'__'.$_.'_flag' ); + } + @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', + [ '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, L, L, L, +L, L, L, L, +schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_svc_column.pm b/FS/FS/part_svc_column.pm new file mode 100644 index 000000000..d2b8fd91b --- /dev/null +++ b/FS/FS/part_svc_column.pm @@ -0,0 +1,120 @@ +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) + +=item columnname - column name in part_svc.svcdb table + +=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_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, L, L, L, +L, L, L, L, +schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_svc_router.pm b/FS/FS/part_svc_router.pm new file mode 100755 index 000000000..df04cc9fb --- /dev/null +++ b/FS/FS/part_svc_router.pm @@ -0,0 +1,33 @@ +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_virtual_field.pm b/FS/FS/part_virtual_field.pm new file mode 100755 index 000000000..ea973bafc --- /dev/null +++ b/FS/FS/part_virtual_field.pm @@ -0,0 +1,301 @@ +package FS::part_virtual_field; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearchs qsearch ); +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 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 +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 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 +LabelValue + +(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!! . $label . + q!! . $value . + q!! . "\n"; + } elsif ($mode eq 'edit') { + $text = q!! . $label . + q!!; + if ($self->list_source) { + $text .= q!length) { + $text .= q! SIZE="! . $self->length . q!"!; + } + $text .= '>'; + } + $text .= q!! . "\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 + +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, L + +=cut + +1; + + diff --git a/FS/FS/pay_batch.pm b/FS/FS/pay_batch.pm new file mode 100644 index 000000000..5448b031e --- /dev/null +++ b/FS/FS/pay_batch.pm @@ -0,0 +1,538 @@ +package FS::pay_batch; + +use strict; +use vars qw( @ISA ); +use Time::Local; +use Text::CSV_XS; +use FS::Record qw( dbh qsearch qsearchs ); +use FS::cust_pay; + +@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 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(); +} + +=item import_results OPTION => VALUE, ... + +Import batch results. + +Options are: + +I - open filehandle of results file. + +I - "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 $filetype; # CSV, Fixed80, Fixed264 + my @fields; + my $formatre; # for Fixed.+ + my @values; + my $begin_condition; + my $end_condition; + my $end_hook; + my $hook; + my $approved_condition; + my $declined_condition; + + if ( $format eq 'csv-td_canada_trust-merchant_pc_batch' ) { + + $filetype = "CSV"; + + @fields = ( + 'paybatchnum', # Reference#: Invoice number of the transaction + 'paid', # Amount: Amount of the transaction. Dollars and cents + # with no decimal entered. + '', # Card Type: 0 - MCrd, 1 - Visa, 2 - AMEX, 3 - Discover, + # 4 - Insignia, 5 - Diners/EnRoute, 6 - JCB + '_date', # Transaction Date: Date the Transaction was processed + 'time', # Transaction Time: Time the transaction was processed + 'payinfo', # Card Number: Card number for the transaction + '', # Expiry Date: Expiry date of the card + '', # Auth#: Authorization number entered for force post + # transaction + 'type', # Transaction Type: 0 - purchase, 40 - refund, + # 20 - force post + 'result', # Processing Result: 3 - Approval, + # 4 - Declined/Amount over limit, + # 5 - Invalid/Expired/stolen card, + # 6 - Comm Error + '', # Terminal ID: Terminal ID used to process the transaction + ); + + $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; + ''; + }; + + $hook = sub { + my $hash = shift; + $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'} / 100 ); + $hash->{'_date'} = timelocal( substr($hash->{'time'}, 4, 2), + substr($hash->{'time'}, 2, 2), + substr($hash->{'time'}, 0, 2), + substr($hash->{'_date'}, 6, 2), + substr($hash->{'_date'}, 4, 2)-1, + substr($hash->{'_date'}, 0, 4)-1900, ); + }; + + $approved_condition = sub { + my $hash = shift; + $hash->{'type'} eq '0' && $hash->{'result'} == 3; + }; + + $declined_condition = sub { + my $hash = shift; + $hash->{'type'} eq '0' && ( $hash->{'result'} == 4 + || $hash->{'result'} == 5 ); + }; + + + }elsif ( $format eq 'csv-chase_canada-E-xactBatch' ) { + + $filetype = "CSV"; + + @fields = ( + '', # Internal(bank) id of the transaction + '', # Transaction Type: 00 - purchase, 01 - preauth, + # 02 - completion, 03 - forcepost, + # 04 - refund, 05 - auth, + # 06 - purchase corr, 07 - refund corr, + # 08 - void 09 - void return + '', # gateway used to process this transaction + 'paid', # Amount: Amount of the transaction. Dollars and cents + # with decimal entered. + 'auth', # Auth#: Authorization number (if approved) + 'payinfo', # Card Number: Card number for the transaction + '', # Expiry Date: Expiry date of the card + '', # Cardholder Name + 'bankcode', # Bank response code (3 alphanumeric) + 'bankmess', # Bank response message + 'etgcode', # ETG response code (2 alphanumeric) + 'etgmess', # ETG response message + '', # Returned customer number for the transaction + 'paybatchnum', # Reference#: paybatch number of the transaction + '', # Reference#: Invoice number of the transaction + 'result', # Processing Result: Approved of Declined + ); + + $end_condition = sub { + ''; + }; + + $hook = sub { + my $hash = shift; + my $cpb = shift; + $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'}); #hmmmm + $hash->{'_date'} = time; # got a better one? + $hash->{'payinfo'} = $cpb->{'payinfo'} + if( substr($hash->{'payinfo'}, -4) eq substr($cpb->{'payinfo'}, -4) ); + }; + + $approved_condition = sub { + my $hash = shift; + $hash->{'etgcode'} eq '00' && $hash->{'result'} eq "Approved"; + }; + + $declined_condition = sub { + my $hash = shift; + $hash->{'etgcode'} ne '00' # internal processing error + || ( $hash->{'result'} eq "Declined" ); + }; + + + }elsif ( $format eq 'PAP' ) { + + $filetype = "Fixed264"; + + @fields = ( + 'recordtype', # We are interested in the 'D' or debit records + 'batchnum', # Record#: batch number we used when sending the file + 'datacenter', # Where in the bowels of the bank the data was processed + 'paid', # Amount: Amount of the transaction. Dollars and cents + # with no decimal entered. + '_date', # Transaction Date: Date the Transaction was processed + 'bank', # Routing information + 'payinfo', # Account number for the transaction + 'paybatchnum', # Reference#: Invoice number of the transaction + ); + + $formatre = '^(.).{19}(.{4})(.{3})(.{10})(.{6})(.{9})(.{12}).{110}(.{19}).{71}$'; + + $end_condition = sub { + my $hash = shift; + $hash->{'recordtype'} eq 'W'; + }; + + $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; + ''; + }; + + $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_condition = sub { + 1; + }; + + $declined_condition = sub { + 0; + }; + + }elsif ( $format eq 'ach-spiritone' ) { + + $filetype = "CSV"; + + @fields = ( + '', # Name + 'paybatchnum', # ID: Number of the transaction + 'aba', # ABA Number for the transaction + 'payinfo', # Bank Account Number for the transaction + '', # Transaction Type: 27 - debit + 'paid', # Amount: Amount of the transaction. Dollars and cents + # with decimal entered. + '', # Default Transaction Type + '', # Default Amount: Dollars and cents with decimal entered. + ); + + $end_condition = sub { + ''; + }; + + $hook = sub { + my $hash = shift; + $hash->{'_date'} = time; # got a better one? + $hash->{'payinfo'} = $hash->{'payinfo'} . '@' . $hash->{'aba'}; + }; + + $approved_condition = sub { + 1; + }; + + $declined_condition = sub { + 0; + }; + + + } else { + return "Unknown format $format"; + } + + 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; + 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(); + }; + @values = $csv->fields(); + }elsif ($filetype eq "Fixed80" || $filetype eq "Fixed264"){ + @values = $line =~ /$formatre/; + unless (@values) { + $dbh->rollback if $oldAutoCommit; + return "can't parse: ". $line; + }; + }else{ + $dbh->rollback if $oldAutoCommit; + return "Unknown file type $filetype"; + } + + my %hash; + foreach my $field ( @fields ) { + my $value = shift @values; + next unless $field; + $hash{$field} = $value; + } + + if ( &{$end_condition}(\%hash) ) { + my $error = &{$end_hook}(\%hash, $total); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + last; + } + + 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); + + if ( &{$approved_condition}(\%hash) ) { + + $new_cust_pay_batch->status('Approved'); + + } elsif ( &{$declined_condition}(\%hash) ) { + + $new_cust_pay_batch->status('Declined'); + + } + + my $error = $new_cust_pay_batch->replace($cust_pay_batch); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error updating status of paybatchnum $hash{'paybatchnum'}: $error\n"; + } + + if ( $new_cust_pay_batch->status =~ /Approved/i ) { + + my $cust_pay = new FS::cust_pay ( { + 'custnum' => $custnum, + 'payby' => $payby, + 'paybatch' => $self->batchnum, + map { $_ => $hash{$_} } (qw( paid _date payinfo )), + } ); + $error = $cust_pay->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error adding payment paybatchnum $hash{'paybatchnum'}: $error\n"; + } + $total += $hash{'paid'}; + + $cust_pay->cust_main->apply_payments; + + } elsif ( $new_cust_pay_batch->status =~ /Declined/i ) { + + #false laziness w/cust_main::collect + + my $due_cust_event = $new_cust_pay_batch->cust_main->due_cust_event( + #'check_freq' => '1d', #? + 'eventtable' => 'cust_pay_batch', + 'objects' => [ $new_cust_pay_batch ], + ); + unless( ref($due_cust_event) ) { + $dbh->rollback if $oldAutoCommit; + return $due_cust_event; + } + + foreach my $cust_event ( @$due_cust_event ) { + + #XXX lock event + + #re-eval event conditions (a previous event could have changed things) + next unless $cust_event->test_conditions; + + if ( my $error = $cust_event->do_event() ) { + # gah, even with transactions. + #$dbh->commit if $oldAutoCommit; #well. + $dbh->rollback if $oldAutoCommit; + return $error; + } + + } + + } + + + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=back + +=head1 BUGS + +status is somewhat redundant now that download and upload exist + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/payby.pm b/FS/FS/payby.pm new file mode 100644 index 000000000..6684c95f0 --- /dev/null +++ b/FS/FS/payby.pm @@ -0,0 +1,185 @@ +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)', + }, + 'DCRD' => { + tinyname => 'card', + shortname => 'Credit card', + longname => 'Credit card (on-demand)', + cust_pay => 'CARD', #this is a customer type only, payments are CARD... + }, + 'CHEK' => { + tinyname => 'check', + shortname => 'Electronic check', + longname => 'Electronic check (automatic)', + }, + 'DCHK' => { + tinyname => 'check', + shortname => 'Electronic check', + longname => 'Electronic check (on-demand)', + cust_pay => 'CHEK', #this is a customer type only, payments are CHEK... + }, + 'LECB' => { + tinyname => 'phone bill', + shortname => 'Phone bill billing', + longname => 'Phone bill billing', + }, + 'BILL' => { + tinyname => 'billing', + shortname => 'Billing', + 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 eq 'cust_pay_batch' || $table eq 'cust_refund'; + return 0 if exists( $hash{$payby}->{$table} ); + + return 1; +} + +sub payby2longname { + my $self = shift; + map { $_ => $hash{$_}->{longname} } $self->payby; +} + +sub shortname { + my( $self, $payby ) = @_; + $hash{$payby}->{shortname}; +} + +sub longname { + my( $self, $payby ) = @_; + $hash{$payby}->{longname}; +} + +%payby2bop = ( + 'CARD' => 'CC', + 'CHEK' => 'ECHECK', +); + +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 new file mode 100644 index 000000000..15c4e3979 --- /dev/null +++ b/FS/FS/payinfo_Mixin.pm @@ -0,0 +1,249 @@ +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. + +This class handles the following functions for payinfo... + +Payment Mask (Generation and Storage) +Data Validation (parent checks need to be sure to call this) +Encryption - In the Future (Pull from Record.pm) +Bad Card Stuff - In the Future (Integrate Banned Pay) +Currency - In the Future + +=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 - see L) + +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) + +=cut + +sub payinfo { + my($self,$payinfo) = @_; + if ( defined($payinfo) ) { + $self->setfield('payinfo', $payinfo); # This is okay since we are the 'setter' + $self->paymask($self->mask_payinfo()); + } else { + $payinfo = $self->getfield('payinfo'); # This is okay since we are the 'getter' + return $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) && $paymask ne '' ) { + # I hate this little bit of magic... I don't expect it to cause a problem, + # but who knows... If the payinfo is passed in masked then ignore it and + # set it based on the payinfo. The only guy that should call this in this + # way is... $self->payinfo + $self->setfield('paymask', $self->mask_payinfo()); + + } else { + + $paymask=$self->getfield('paymask'); + if (!defined($paymask) || $paymask eq '') { + # Generate it if it's blank - Note that we're not going to set it - just + # generate + $paymask = $self->mask_payinfo(); + } + + } + + return $paymask; +} + +=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'; + } 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; + } + } + return $paymask; +} + +=cut + +sub _mask_payinfo { + my $self = shift; + +=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 and sets billing type to I) + +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' ) { + 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 { + my $error = $self->ut_textn('payinfo'); + return $error if $error; + } +} + +=head1 BUGS + +Have to add the future items... + +=head1 SEE ALSO + +L, L + +=cut + +1; + diff --git a/FS/FS/payment_gateway.pm b/FS/FS/payment_gateway.pm new file mode 100644 index 000000000..35b4f0835 --- /dev/null +++ b/FS/FS/payment_gateway.pm @@ -0,0 +1,200 @@ +package FS::payment_gateway; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs dbh ); +use FS::option_Common; +use FS::agent_payment_gateway; + +@ISA = qw( FS::option_Common ); + +=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_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 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_textn('gateway_username') + || $self->ut_anything('gateway_password') + || $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'); + } + + $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 field to "B". + +=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; + ''; + +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/payment_gateway_option.pm b/FS/FS/payment_gateway_option.pm new file mode 100644 index 000000000..057602291 --- /dev/null +++ b/FS/FS/payment_gateway_option.pm @@ -0,0 +1,126 @@ +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 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, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/pkg_class.pm b/FS/FS/pkg_class.pm new file mode 100644 index 000000000..bab6e5e56 --- /dev/null +++ b/FS/FS/pkg_class.pm @@ -0,0 +1,113 @@ +package FS::pkg_class; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch ); +use FS::part_pkg; + +@ISA = qw( FS::Record ); + +=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) 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 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'; } + +=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. + +=cut + +sub delete { + my $self = shift; + + return "Can't delete an pkg_class with part_pkg records!" + if qsearch( 'part_pkg', { 'classnum' => $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 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; + + $self->ut_numbern('classnum') + or $self->ut_text('classname') + or $self->SUPER::check; + +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/pkg_referral.pm b/FS/FS/pkg_referral.pm new file mode 100644 index 000000000..333c2bf8a --- /dev/null +++ b/FS/FS/pkg_referral.pm @@ -0,0 +1,126 @@ +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 + +=item refnum - Advertising source. See L + +=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 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, L, L, schema.html from the +base documentation. + +=cut + +1; + diff --git a/FS/FS/pkg_svc.pm b/FS/FS/pkg_svc.pm new file mode 100644 index 000000000..9f3a4a1b7 --- /dev/null +++ b/FS/FS/pkg_svc.pm @@ -0,0 +1,160 @@ +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) to +a service definition (see L). 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) + +=item svcpart - Service definition (see L) + +=item quantity - Quantity of this service definition that this billing item +definition includes + +=item primary_svc - primary flag, empty or 'Y' + +=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') + ; + 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). + +=cut + +sub part_pkg { + my $self = shift; + qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); +} + +=item part_svc + +Returns the FS::part_svc object (see L). + +=cut + +sub part_svc { + my $self = shift; + qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/FS/port.pm b/FS/FS/port.pm new file mode 100644 index 000000000..c26ca85d4 --- /dev/null +++ b/FS/FS/port.pm @@ -0,0 +1,154 @@ +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 + +=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 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. + +=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 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, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/prepay_credit.pm b/FS/FS/prepay_credit.pm new file mode 100644 index 000000000..302ba37c7 --- /dev/null +++ b/FS/FS/prepay_credit.pm @@ -0,0 +1,202 @@ +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) + +=item agentnum - optional agent (see L) 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 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) 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 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, $hashref ) = @_; + + my @codeset = (); + push @codeset, ( 'A'..'Z' ) if $type =~ /alpha/; + push @codeset, ( '1'..'9' ) if $type =~ /numeric/; + + 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)], (0..7) ) ); + + 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, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm new file mode 100644 index 000000000..5f8bf11f0 --- /dev/null +++ b/FS/FS/queue.pm @@ -0,0 +1,465 @@ +package FS::queue; + +use strict; +use vars qw( @ISA @EXPORT_OK $DEBUG $conf $jobnums); +use Exporter; +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; + +@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 + +=item statustext - freeform text status message + +=item _date - UNIX timestamp + +=item svcnum - optional link to service (see L) + +=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 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). + +=cut + +#false laziness w/part_export.pm +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; + } + + foreach my $arg ( @_ ) { + my $queue_arg = new FS::queue_arg ( { + 'jobnum' => $self->jobnum, + 'arg' => $arg, + } ); + $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 $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; + + ''; + +} + +=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 )]) + || $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 $_->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->statustext; + 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->statustext($statustext); + ''; + + #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!
    !. + FS::CGI::table(). < + Job + Args + Date + Status +END + $html .= 'Account' unless $hashref->{svcnum}; + $html .= ''; + + 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! ( retry |!. + qq! remove )!; + } + my $cust_svc = $queue->cust_svc; + + $html .= < + $jobnum + $queue_hashref->{job} + $args + $date + $status +END + + unless ( $hashref->{svcnum} ) { + my $account; + if ( $cust_svc ) { + my $table = $cust_svc->part_svc->svcdb; + my $label = ( $cust_svc->label )[1]; + $account = qq!$label!; + } else { + $account = ''; + } + $html .= "$account"; + } + + if ( $changable ) { + $areboxes=1; + $html .= + qq!!; + + } + + $html .= ''; + +} + + $html .= ''; + + if ( $areboxes ) { + $html .= '
    '. + '
    '; + } + + $html; + +} + +=back + +=head1 BUGS + +$jobnums global + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/queue_arg.pm b/FS/FS/queue_arg.pm new file mode 100644 index 000000000..c96ff1236 --- /dev/null +++ b/FS/FS/queue_arg.pm @@ -0,0 +1,117 @@ +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 + +=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 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_anything('arg') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/queue_depend.pm b/FS/FS/queue_depend.pm new file mode 100644 index 000000000..99a22c5c6 --- /dev/null +++ b/FS/FS/queue_depend.pm @@ -0,0 +1,121 @@ +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). + +=item depend_jobnum - dependancy jobnum (see L) + +=back + +The job specified by B depends on the job specified B - +the B job will not be run until the B 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 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, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/raddb.pm b/FS/FS/raddb.pm new file mode 100644 index 000000000..506b32568 --- /dev/null +++ b/FS/FS/raddb.pm @@ -0,0 +1,1912 @@ +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 new file mode 100644 index 000000000..9bba057c9 --- /dev/null +++ b/FS/FS/radius_usergroup.pm @@ -0,0 +1,131 @@ +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) 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). + +=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 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). + +=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, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/rate.pm b/FS/FS/rate.pm new file mode 100644 index 000000000..c50ca044a --- /dev/null +++ b/FS/FS/rate.pm @@ -0,0 +1,379 @@ +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 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 + +If I 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 + +If I 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 + +Returns the rate detail (see L) for this rate to the +specificed destination. + +=cut + +sub dest_detail { + my $self = shift; + my $regionnum = ref($_[0]) ? shift->regionnum : shift; + qsearchs( 'rate_detail', { 'ratenum' => $self->ratenum, + 'dest_regionnum' => $regionnum, } ); +} + +=item rate_detail + +Returns all region-specific details (see L) 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 ) + }; + + } else { + + new FS::rate_detail { + 'dest_regionnum' => $regionnum, + 'min_included' => 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; + $error = $rate->replace( $old, + 'rate_detail' => \@rate_detail, + 'job' => $job, + ); + } 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, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/rate_detail.pm b/FS/FS/rate_detail.pm new file mode 100644 index 000000000..ad41b40ec --- /dev/null +++ b/FS/FS/rate_detail.pm @@ -0,0 +1,202 @@ +package FS::rate_detail; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs ); +use FS::rate; +use FS::rate_region; + +@ISA = qw(FS::Record); + +=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) + +=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 + +=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 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') + ; + return $error if $error; + + $self->SUPER::check; +} + +=item rate + +Returns the parent call plan (see L) 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) 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) 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) 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) associated with this call plan rate. + +=cut + +sub dest_prefixes_short { + my $self = shift; + $self->dest_region->prefixes_short; +} + + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, +schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/rate_prefix.pm b/FS/FS/rate_prefix.pm new file mode 100644 index 000000000..42b004f5b --- /dev/null +++ b/FS/FS/rate_prefix.pm @@ -0,0 +1,139 @@ +package FS::rate_prefix; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs ); +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) + +=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 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) for this prefix. + +=cut + +sub rate_region { + my $self = shift; + qsearchs('rate_region', { 'regionnum' => $self->regionnum } ); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/rate_region.pm b/FS/FS/rate_region.pm new file mode 100644 index 000000000..65dfd2a25 --- /dev/null +++ b/FS/FS/rate_region.pm @@ -0,0 +1,313 @@ +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 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 and I + +If I 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 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 and I + +If I 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 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) 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) 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, 3 ) if length($npa) > 3; + } else { + $out .= $rate_prefix->npa; + } + $out .= ', '; + } + $out =~ s/, $//; + + $out; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/reason.pm b/FS/FS/reason.pm new file mode 100644 index 000000000..5311ec5aa --- /dev/null +++ b/FS/FS/reason.pm @@ -0,0 +1,184 @@ +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 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 FS::reason_type) associated with this reason. + +=cut + +sub reasontype { + qsearchs( 'reason_type', { 'typenum' => shift->reason_type } ); +} + +# _upgrade_data +# +# Used by FS::Upgrade to migrate to a new database. +# +# + +sub _upgrade_data { # class method + my ($self, %opts) = @_; + my $dbh = dbh; + + warn "$me upgrading $self\n" if $DEBUG; + + my $column = dbdef->table($self->table)->column('reason'); + unless ($column->type eq 'text') { # assume history matches main table + + # ideally this would be supported in DBIx-DBSchema and friends + warn "$me Shifting reason column to type 'text'\n" if $DEBUG; + foreach my $table ( $self->table, 'h_'. $self->table ) { + my @sql = (); + + $column = dbdef->table($self->table)->column('reason'); + my $columndef = $column->line($dbh); + $columndef =~ s/varchar\(\d+\)/text/i; + + if ( $dbh->{Driver}->{Name} eq 'Pg' ) { + + my $notnull = $columndef =~ s/not null//i; + push @sql,"ALTER TABLE $table RENAME reason TO freeside_upgrade_reason"; + push @sql,"ALTER TABLE $table ADD $columndef"; + push @sql,"UPDATE $table SET reason = freeside_upgrade_reason"; + push @sql,"ALTER TABLE $table ALTER reason SET NOT NULL" + if $notnull; + push @sql,"ALTER TABLE $table DROP freeside_upgrade_reason"; + + } elsif ( $dbh->{Driver}->{Name} =~ /^mysql/i ){ + + #crap, this isn't working + #push @sql,"ALTER TABLE $table MODIFY reason ". $column->line($dbh); + warn "WARNING: reason table upgrade not yet supported for mysql, sorry"; + + } else { + die "watchu talkin' 'bout, Willis? (unsupported database type)"; + } + + foreach (@sql) { + my $sth = $dbh->prepare($_) or die $dbh->errstr; + $sth->execute or die $sth->errstr; + } + } + } + + ''; + +} +=back + +=head1 BUGS + +Here be termintes. Don't use on wooden computers. + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/reason_type.pm b/FS/FS/reason_type.pm new file mode 100644 index 000000000..482ea34e8 --- /dev/null +++ b/FS/FS/reason_type.pm @@ -0,0 +1,211 @@ +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 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; +# # or clause for 1.7.x + $conf->set($_, $object->typenum) + or die "failed setting config"; + } + + ''; + +} + +# _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, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/reg_code.pm b/FS/FS/reg_code.pm new file mode 100644 index 000000000..f48ccf048 --- /dev/null +++ b/FS/FS/reg_code.pm @@ -0,0 +1,223 @@ +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) + +=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 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) is specified, the appropriate reg_code_pkg records +(see L) 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 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, L, schema.html from the base documentation. + +=cut + +1; + + diff --git a/FS/FS/reg_code_pkg.pm b/FS/FS/reg_code_pkg.pm new file mode 100644 index 000000000..837b755e6 --- /dev/null +++ b/FS/FS/reg_code_pkg.pm @@ -0,0 +1,139 @@ +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) with package definitions (see L) + +=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) + +=item pkgpart - package definition (see L) + +=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 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) + +=cut + +sub part_pkg { + my $self = shift; + qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart } ); +} + +=back + +=head1 BUGS + +Feeping creaturitis. + +=head1 SEE ALSO + +L, L, schema.html from the base documentation. + +=cut + +1; + + diff --git a/FS/FS/registrar.pm b/FS/FS/registrar.pm new file mode 100644 index 000000000..cf5dc4907 --- /dev/null +++ b/FS/FS/registrar.pm @@ -0,0 +1,119 @@ +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 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, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/router.pm b/FS/FS/router.pm new file mode 100755 index 000000000..88ba99032 --- /dev/null +++ b/FS/FS/router.pm @@ -0,0 +1,140 @@ +package FS::router; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearchs qsearch ); +use FS::addr_block; + +@ISA = qw( FS::Record ); + +=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'); + 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; +} + +=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 new file mode 100644 index 000000000..615c8ae8b --- /dev/null +++ b/FS/FS/session.pm @@ -0,0 +1,265 @@ +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 + +=item svcnum - User for this session - see L + +=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 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). + +=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). + +=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, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm new file mode 100644 index 000000000..787acee22 --- /dev/null +++ b/FS/FS/svc_Common.pm @@ -0,0 +1,815 @@ +package FS::svc_Common; + +use strict; +use vars qw( @ISA $noexport_hack $DEBUG $me ); +use Carp qw( cluck carp croak ); #specify cluck have to specify them all.. +use FS::Record qw( qsearch qsearchs fields dbh ); +use FS::cust_main_Mixin; +use FS::cust_svc; +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; + +=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. + +=cut + +sub search_sql_field { + my( $class, $field, $string ) = @_; + my $table = $class->table; + my $q_string = dbh->quote($string); + "$table.$field = $q_string"; +} + +#fallback for services that don't provide a search... +sub search_sql { + #my( $class, $string ) = @_; + '1 = 0'; #false +} + +=item new + +=cut + +sub new { + 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; +} + +=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) should be +defined. An FS::cust_svc record will be created and inserted. + +Currently available options are: I, I and +I. + +If I is set to an array reference, the jobnums of any export jobs will +be added to the referenced array. + +If I 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 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 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); + 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; + return $error if $error; + + 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, + } ); + $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); + } + + $error = $self->set_auto_inventory; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $error = $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; + + ''; +} + +=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->SUPER::delete + || $self->export('delete', @$export_args) + || $self->return_inventory + || $self->cust_svc->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. If there is an error, returns the error, +otherwise returns false. + +=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; + + # We absolutely have to have an old vs. new record to make this work. + $old = $new->replace_old unless defined($old); + + my $error = $new->set_auto_inventory; + 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). 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), 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 "Unkonwn 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 set_auto_inventory + +Sets any fields which auto-populate from inventory (see L). +If there is an error, returns the error, otherwise returns false. + +=cut + +sub set_auto_inventory { + my $self = 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); + if ( $part_svc_column->columnflag eq 'A' && $self->$field() eq '' ) { + + my $classnum = $part_svc_column->columnvalue; + my $inventory_item = qsearchs({ + 'table' => 'inventory_item', + 'hashref' => { 'classnum' => $classnum, + 'svcnum' => '', + }, + 'extra_sql' => 'LIMIT 1 FOR UPDATE', + }); + + 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 + } + + $inventory_item->svcnum( $self->svcnum ); + my $ierror = $inventory_item->replace(); + if ( $ierror ) { + $dbh->rollback if $oldAutoCommit; + return "Error provisioning inventory: $ierror"; + + } + + $self->setfield( $field, $inventory_item->item ); + + } + } + + $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. + +=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). + +=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 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(@_); +} + +=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). + +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; +} + +=back + +=head1 BUGS + +The setfixed method return value. + +B method isn't used by insert and replace methods yet. + +=head1 SEE ALSO + +L, L, L, L, schema.html +from the base documentation. + +=cut + +1; + diff --git a/FS/FS/svc_External_Common.pm b/FS/FS/svc_External_Common.pm new file mode 100644 index 000000000..a5805aafd --- /dev/null +++ b/FS/FS/svc_External_Common.pm @@ -0,0 +1,199 @@ +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 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 new file mode 100644 index 000000000..4501bafc8 --- /dev/null +++ b/FS/FS/svc_Parent_Mixin.pm @@ -0,0 +1,103 @@ +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 new file mode 100644 index 000000000..4343df5cc --- /dev/null +++ b/FS/FS/svc_acct.pm @@ -0,0 +1,2664 @@ +package FS::svc_acct; + +use strict; +use vars qw( @ISA $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 + $password_noampersand $password_noexclamation + $warning_template $warning_from $warning_subject $warning_mimetype + $warning_cc + $smtpmachine + $radius_password $radius_ip + $dirhash + @saltset @pw_set ); +use Carp; +use Fcntl qw(:flock); +use Date::Format; +use Crypt::PasswdMD5 1.2; +use Data::Dumper; +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::svc_Common; +use FS::cust_svc; +use FS::part_svc; +use FS::svc_acct_pop; +use FS::cust_main_invoice; +use FS::svc_domain; +use FS::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; + +@ISA = qw( FS::svc_Common ); + +$DEBUG = 0; +$me = '[FS::svc_acct]'; + +#ask FS::UID to run this stuff for us later +$FS::UID::callback{'FS::svc_acct'} = 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; + $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'); + $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 - (unimplementd) + +=item slipip - IP address + +=item seconds - + +=item upbytes - + +=item downbytes - + +=item totalbytes - + +=item domsvc - svcnum from svc_domain + +=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_label => 'UID (set to fixed and blank for no UIDs)', + type => 'text', + }, + 'slipip' => 'IP address', + # 'popnum' => qq!<A HREF="$p/browse/svc_acct_pop.cgi/">POP number</A>!, + 'popnum' => { + label => 'Access number', + type => 'select', + select_table => 'svc_acct_pop', + select_key => 'popnum', + select_label => 'city', + disable_select => 1, + }, + 'username' => { + label => 'Username', + type => 'text', + disable_default => 1, + disable_fixed => 1, + disable_select => 1, + }, + 'quota' => { + label => 'Quota', + type => 'text', + disable_inventory => 1, + disable_select => 1, + }, + '_password' => 'Password', + 'gid' => { + label => 'GID', + def_label => 'GID (when blank, defaults to UID)', + type => 'text', + }, + 'shell' => { + #desc =>'Shell (all service definitions should have a default or fixed shell that is present in the <b>shells</b> configuration file, set to blank for no shell tracking)', + label => 'Shell', + def_label=> 'Shell (set to blank for no shell tracking)', + type =>'select', + select_list => [ $conf->config('shells') ], + disable_inventory => 1, + disable_select => 1, + }, + 'finger' => 'Real name (GECOS)', + 'domsvc' => { + label => 'Domain', + #def_label => 'svcnum from svc_domain', + type => 'select', + select_table => 'svc_domain', + select_key => 'svcnum', + select_label => 'domain', + disable_inventory => 1, + + }, + 'usergroup' => { + label => 'RADIUS groups', + type => 'radius_usergroup_selector', + disable_inventory => 1, + disable_select => 1, + }, + 'seconds' => { label => 'Seconds', + label_sort => 'with Time Remaining', + type => 'text', + disable_inventory => 1, + disable_select => 1, + }, + 'upbytes' => { label => 'Upload', + type => 'text', + disable_inventory => 1, + disable_select => 1, + 'format' => \&FS::UI::bytecount::display_bytecount, + 'parse' => \&FS::UI::bytecount::parse_bytecount, + }, + 'downbytes' => { label => 'Download', + type => 'text', + disable_inventory => 1, + disable_select => 1, + 'format' => \&FS::UI::bytecount::display_bytecount, + 'parse' => \&FS::UI::bytecount::parse_bytecount, + }, + '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, + }, + 'seconds_threshold' => { label => 'Seconds threshold', + type => 'text', + disable_inventory => 1, + disable_select => 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, + }, + '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, + }, + '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, + }, + 'last_login'=> { + label => 'Last login', + type => 'disabled', + }, + 'last_logout'=> { + label => 'Last logout', + type => 'disabled', + }, + }, + }; +} + +sub table { 'svc_acct'; } + +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(@_); +} + +=cut + +=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 $error = $self->check; + return $error if $error; + + if ( $self->svcnum && qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) ) { + my $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); + } + + $error = $self->_check_duplicate; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + my @jobnums; + $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 ($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 && $cust_pkg ) { + 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 ( $cust_pkg ) + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; #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, $old ) = ( shift, shift ); + my $error; + warn "$me replacing $old with $new\n" if $DEBUG; + + # We absolutely have to have an old vs. new record to make this work. + if (!defined($old)) { + $old = qsearchs( 'svc_acct', { 'svcnum' => $new->svcnum } ); + } + + 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"; + } + } + + } + + if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) { + $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 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_textn('sec_phrase') + || $self->ut_snumbern('seconds') + || $self->ut_snumbern('upbytes') + || $self->ut_snumbern('downbytes') + || $self->ut_snumbern('totalbytes') + || $self->ut_enum( '_password_encoding', + [ '', qw( plain crypt ldap ) ] + ) + ; + return $error if $error; + + my $ulen = $usernamemax || $self->dbdef_table->column('username')->length; + if ( $username_uppercase ) { + $recref->{username} =~ /^([a-z0-9_\-\.\&\%]{$usernamemin,$ulen})$/i + or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username}; + $recref->{username} = $1; + } else { + $recref->{username} =~ /^([a-z0-9_\-\.\&\%]{$usernamemin,$ulen})$/ + or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username}; + $recref->{username} = $1; + } + + 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'); + } + + $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') =~ + /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\'\"\,\.\?\/\*\<\>]*)$/ + or return "Illegal finger: ". $self->getfield('finger'); + $self->setfield('finger', $1); + + $recref->{quota} =~ /^(\w*)$/ or return "Illegal quota"; + $recref->{quota} = $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($_); + } + + 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} = $1.$2; + + } else { + return 'Illegal (crypt-encoded) password'; + } + + } elsif ( $recref->{_password_encoding} eq 'plain' ) { + + #generate a password if it is blank + $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) ) + unless length( $recref->{_password} ); + + 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 { + + #carp "warning: _password_encoding unspecified\n"; + + #generate a password if it is blank + unless ( length( $recref->{_password} ) ) { + + $recref->{_password} = + join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) ); + $recref->{_password_encoding} = 'plain'; + + } else { + + #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) { + if ( $recref->{_password} =~ /^((\*SUSPENDED\* |!!?)?)([^\t\n]{$passwordmin,$passwordmax})$/ ) { + $recref->{_password} = $1.$3; + $recref->{_password_encoding} = 'plain'; + } elsif ( $recref->{_password} =~ + /^((\*SUSPENDED\* |!!?)?)([\w\.\/\$\;\+]{13,64})$/ + ) { + $recref->{_password} = $1.$3; + $recref->{_password_encoding} = 'crypt'; + } elsif ( $recref->{_password} eq '*' ) { + $recref->{_password} = '*'; + $recref->{_password_encoding} = 'crypt'; + } elsif ( $recref->{_password} eq '!' ) { + $recref->{_password_encoding} = 'crypt'; + $recref->{_password} = '!'; + } elsif ( $recref->{_password} eq '!!' ) { + $recref->{_password} = '!!'; + $recref->{_password_encoding} = 'crypt'; + } else { + #return "Illegal password"; + return gettext('illegal_password'). " $passwordmin-$passwordmax ". + FS::Msgcat::_gettext('illegal_password_characters'). + ": ". $recref->{_password}; + } + + } + + } + + $self->SUPER::check; + +} + +=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 function 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'; + + warn "$me locking svc_acct table for duplicate search" if $DEBUG; + if ( driver_name =~ /^Pg/i ) { + dbh->do("LOCK TABLE svc_acct IN SHARE ROW EXCLUSIVE MODE") + or die dbh->errstr; + } elsif ( driver_name =~ /^mysql/i ) { + dbh->do("SELECT * FROM duplicate_lock + WHERE lockname = 'svc_acct' + FOR UPDATE" + ) or die dbh->errstr; + } else { + die "unknown database ". driver_name. + "; don't know how to lock for duplicate search"; + } + warn "$me acquired svc_acct table lock for duplicate search" if $DEBUG; + + 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: 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: 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: 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; + } + + %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 $password = $self->_password; + my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password'; $check{$pw_attrib} = $password; + + my $cust_svc = $self->cust_svc; + die "FATAL: no cust_svc record for svc_acct.svcnum ". $self->svcnum. "\n" + unless $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 + } + + %check; + +} + +=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 svc_domain + +Returns the FS::svc_domain record for this account's domain (see +L<FS::svc_domain>). + +=cut + +# FS::h_svc_acct has a history-aware svc_domain override + +sub svc_domain { + my $self = shift; + $self->{'_domsvc'} + ? $self->{'_domsvc'} + : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } ); +} + +=item cust_svc + +Returns the FS::cust_svc record for this account (see L<FS::cust_svc>). + +=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. +If the acct_snarf table does not exist or there are no associated records, +an empty list is returned + +=cut + +sub acct_snarf { + my $self = shift; + return () unless dbdef->table('acct_snarf'); + eval "use FS::acct_snarf;"; + die $@ if $@; + qsearch('acct_snarf', { 'svcnum' => $self->svcnum } ); +} + +=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 + $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 + $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; + + my $action = $op2action{$op}; + + if ( &{$op2condition{$op}}($self, $column, $amount) && + ( $action eq 'suspend' && !$self->overlimit + || $action eq 'unsuspend' && $self->overlimit ) + ) { + foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { + if ($part_export->option('overlimit_groups')) { + my ($new,$old); + my $other = new FS::svc_acct $self->hashref; + my $groups = &{ $self->_fieldhandlers->{'usergroup'} } + ($self, $part_export->option('overlimit_groups')); + $other->usergroup( $groups ); + if ($action eq 'suspend'){ + $new = $other; $old = $self; + }else{ + $new = $self; $old = $other; + } + my $error = $part_export->export_replace($new, $old); + $error ||= $self->overlimit($action); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error replacing radius groups in export, ${op}: $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 set_usage { + my( $self, $valueref ) = @_; + + 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 = (); + 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 = ?"; + + 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), $self->svcnum); + die "Error executing $sql: ". $sth->errstr + unless defined($rv); + die "Can't update usage for svcnum ". $self->svcnum + if $rv == 0; + } + + if ( $reset ) { + my $error; + + if ($self->overlimit) { + $error = $self->overlimit('unsuspend'); + foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { + if ($part_export->option('overlimit_groups')) { + my $old = new FS::svc_acct $self->hashref; + my $groups = &{ $self->_fieldhandlers->{'usergroup'} } + ($self, $part_export->option('overlimit_groups')); + $old->usergroup( $groups ); + $error ||= $part_export->export_replace($self, $old); + } + } + } + + if ( $conf->exists("svc_acct-usage_unsuspend")) { + $error ||= $self->cust_svc->cust_pkg->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 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) + +=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 + +=item domain_select_hash %OPTIONS + +Returns a hash SVCNUM => DOMAIN ... representing the domains this customer +may at present purchase. + +Currently available options are: I<pkgnum> I<svcpart> + +=cut + +sub domain_select_hash { + my ($self, %options) = @_; + my %domains = (); + my $part_svc; + my $cust_pkg; + + if (ref($self)) { + $part_svc = $self->part_svc; + $cust_pkg = $self->cust_svc->cust_pkg + if $self->cust_svc; + } + + $part_svc = qsearchs('part_svc', { 'svcpart' => $options{svcpart} }) + if $options{'svcpart'}; + + $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $options{pkgnum} }) + if $options{'pkgnum'}; + + if ($part_svc && ( $part_svc->part_svc_column('domsvc')->columnflag eq 'S' + || $part_svc->part_svc_column('domsvc')->columnflag eq 'F')) { + %domains = map { $_->svcnum => $_->domain } + map { qsearchs('svc_domain', { 'svcnum' => $_ }) } + split(',', $part_svc->part_svc_column('domsvc')->columnvalue); + }elsif ($cust_pkg && !$conf->exists('svc_acct-alldomains') ) { + %domains = map { $_->svcnum => $_->domain } + map { qsearchs('svc_domain', { 'svcnum' => $_->svcnum }) } + map { qsearch('cust_svc', { 'pkgnum' => $_->pkgnum } ) } + qsearch('cust_pkg', { 'custnum' => $cust_pkg->custnum }); + }else{ + %domains = map { $_->svcnum => $_->domain } qsearch('svc_domain', {} ); + } + + if ($part_svc && $part_svc->part_svc_column('domsvc')->columnflag eq 'D') { + my $svc_domain = qsearchs('svc_domain', + { 'svcnum' => $part_svc->part_svc_column('domsvc')->columnvalue } ); + if ( $svc_domain ) { + $domains{$svc_domain->svcnum} = $svc_domain->domain; + }else{ + warn "unknown svc_domain.svcnum for part_svc_column domsvc: ". + $part_svc->part_svc_column('domsvc')->columnvalue; + + } + } + + (%domains); +} + +1; + diff --git a/FS/FS/svc_acct_pop.pm b/FS/FS/svc_acct_pop.pm new file mode 100644 index 000000000..de41f5bb6 --- /dev/null +++ b/FS/FS/svc_acct_pop.pm @@ -0,0 +1,206 @@ +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 new file mode 100755 index 000000000..68e7496d1 --- /dev/null +++ b/FS/FS/svc_broadband.pm @@ -0,0 +1,297 @@ +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 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' => 'Address block.', + }, + }; +} + +sub table { 'svc_broadband'; } + +=item search_sql STRING + +Class method which returns an SQL fragment to search for the given string. + +=cut + +sub search_sql { + my( $class, $string ) = @_; + if ( $string =~ /^(\d{1,3}\.){3}\d{1,3}$/ ) { + $class->search_sql_field('ip_addr', $string ); + }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_foreign_key('blocknum', 'addr_block', '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'; } + + if (not($self->ip_addr) or $self->ip_addr eq '0.0.0.0') { + 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.")"; + } + } + + # 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; + } + + $self->SUPER::check; +} + +=item NetAddr + +Returns a NetAddr::IP object containing the IP address of this service. The netmask +is /32. + +=cut + +sub NetAddr { + my $self = shift; + return 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; + + return 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; + + return map { $_->router } qsearch('part_svc_router', { svcpart => $self->svcpart }); +} + +=head1 BUGS + +The business with sb_field has been 'fixed', in a manner of speaking. + +=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_domain.pm b/FS/FS/svc_domain.pm new file mode 100644 index 000000000..758b399be --- /dev/null +++ b/FS/FS/svc_domain.pm @@ -0,0 +1,478 @@ +package FS::svc_domain; + +use strict; +use vars qw( @ISA $whois_hack $conf + @defaultrecords $soadefaultttl $soaemail $soaexpire $soamachine + $soarefresh $soaretry +); +use Carp; +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::svc_Common; +use FS::svc_Parent_Mixin; +use FS::cust_svc; +use FS::svc_acct; +use FS::cust_pkg; +use FS::cust_main; +use FS::domain_record; +use FS::queue; + +@ISA = qw( FS::svc_Parent_Mixin FS::svc_Common ); + +#ask FS::UID to run this stuff for us later +$FS::UID::callback{'FS::domain'} = sub { + $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 + +=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', + }, + }; +} + +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 or I<M> +for transfers. + +A registration or transfer email will be submitted unless +$FS::svc_domain::whois_hack is true. + +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->check; + return $error if $error; + + return "Domain in use (here)" + if qsearchs( 'svc_domain', { 'domain' => $self->domain } ); + + + $error = $self->SUPER::insert(@_); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + 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 )" + }; + $error = $soa->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "couldn't insert SOA record for new domain: $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 for new domain: $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, $old ) = ( shift, shift ); + + # We absolutely have to have an old vs. new record to make this work. + $old = $new->replace_old unless defined($old); + + return "Can't change domain - reorder." + if $old->getfield('domain') ne $new->getfield('domain'); + + # Better to do it here than to force the caller to remember that svc_domain is weird. + $new->setfield(action => 'M'); + 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') + ; + 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->ut_textn('purpose') + or $self->SUPER::check; + +} + +=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, + ); + + 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 }, + ); + + 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_external.pm b/FS/FS/svc_external.pm new file mode 100644 index 000000000..0fb391fef --- /dev/null +++ b/FS/FS/svc_external.pm @@ -0,0 +1,204 @@ +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; + $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 new file mode 100644 index 000000000..3250f8ac0 --- /dev/null +++ b/FS/FS/svc_forward.pm @@ -0,0 +1,371 @@ +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->check; + return $error if $error; + + $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_phone.pm b/FS/FS/svc_phone.pm new file mode 100644 index 000000000..00ccc1958 --- /dev/null +++ b/FS/FS/svc_phone.pm @@ -0,0 +1,190 @@ +package FS::svc_phone; + +use strict; +use vars qw( @ISA ); +#use FS::Record qw( qsearch qsearchs ); +use FS::svc_Common; + +@ISA = qw( FS::svc_Common ); + +=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 pin - + +=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 { + { + 'name' => 'Phone number', + 'sorts' => 'phonenum', + 'display_weight' => 60, + 'cancel_weight' => 80, + 'fields' => { + 'countrycode' => { label => 'Country code', + type => 'text', + disable_inventory => 1, + disable_select => 1, + }, + 'phonenum' => 'Phone number', + 'pin' => { label => 'Personal Identification Number', + type => 'text', + disable_inventory => 1, + disable_select => 1, + }, + }, + }; +} + +sub table { 'svc_phone'; } + +=item search_sql STRING + +Class method which returns an SQL fragment to search for the given string. + +=cut + +sub search_sql { + my( $class, $string ) = @_; + $class->search_sql_field('phonenum', $string ); +} + +=item label + +Returns the phone number. + +=cut + +sub label { + my $self = shift; + $self->phonenum; #XXX format it better +} + +=item insert + +Adds this record to the database. If there is an error, returns the error, +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 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 $error = + $self->ut_numbern('svcnum') + || $self->ut_numbern('countrycode') + || $self->ut_number('phonenum') + || $self->ut_numbern('pin') + ; + return $error if $error; + + $self->countrycode(1) unless $self->countrycode; + + $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_www.pm b/FS/FS/svc_www.pm new file mode 100644 index 000000000..53225bbc6 --- /dev/null +++ b/FS/FS/svc_www.pm @@ -0,0 +1,312 @@ +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 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; + + #if ( $self->recnum =~ /^([\w\-]+|\@)\.(([\w\.\-]+\.)+\w+)$/ ) { + if ( $self->recnum =~ /^([\w\-]+|\@)\.(\d+)$/ ) { + my( $reczone, $domain_svcnum ) = ( $1, $2 ); + unless ( $apacheip ) { + $dbh->rollback if $oldAutoCommit; + 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, + }; + $error = $domain_record->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $self->recnum($domain_record->recnum); + } + + $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; + 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/type_pkgs.pm b/FS/FS/type_pkgs.pm new file mode 100644 index 000000000..bf34e7cda --- /dev/null +++ b/FS/FS/type_pkgs.pm @@ -0,0 +1,125 @@ +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_number('typenum') + || $self->ut_number('pkgpart') + ; + return $error if $error; + + return "Unknown typenum" + unless qsearchs( 'agent_type', { 'typenum' => $self->typenum } ); + + return "Unknown pkgpart" + unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); + + $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 } ); +} + +=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/MANIFEST b/FS/MANIFEST new file mode 100644 index 000000000..635bc04c0 --- /dev/null +++ b/FS/MANIFEST @@ -0,0 +1,396 @@ +Changes +MANIFEST +MANIFEST.SKIP +Makefile.PL +bin/freeside-addoutsource +bin/freeside-addoutsourceuser +bin/freeside-addgroup +bin/freeside-adduser +bin/freeside-apply-credits +bin/freeside-count-active-customers +bin/freeside-daily +bin/freeside-deloutsource +bin/freeside-deloutsourceuser +bin/freeside-deluser +bin/freeside-email +bin/freeside-expiration-alerter +bin/freeside-queued +bin/freeside-radgroup +bin/freeside-reexport +bin/freeside-selfservice-server +bin/freeside-setinvoice +bin/freeside-setup +bin/freeside-sqlradius-radacctd +bin/freeside-sqlradius-reset +bin/freeside-sqlradius-seconds +FS.pm +FS/AccessRight.pm +FS/CGI.pm +FS/InitHandler.pm +FS/ClientAPI.pm +FS/ClientAPI_SessionCache.pm +FS/ClientAPI/passwd.pm +FS/ClientAPI/MyAccount.pm +FS/Conf.pm +FS/ConfItem.pm +FS/Cron/backup.pm +FS/Cron/bill.pm +FS/Cron/vacuum.pm +FS/Daemon.pm +FS/Misc.pm +FS/Record.pm +FS/Report.pm +FS/Report/Table.pm +FS/Report/Table/Monthly.pm +FS/SearchCache.pm +FS/UI/Web.pm +FS/UID.pm +FS/Msgcat.pm +FS/Pony.pm +FS/acct_snarf.pm +FS/agent.pm +FS/agent_type.pm +FS/cust_bill.pm +FS/cust_bill_pkg.pm +FS/cust_bill_pkg_detail.pm +FS/cust_credit.pm +FS/cust_credit_bill.pm +FS/cust_main.pm +FS/cust_main_Mixin.pm +FS/cust_main_county.pm +FS/cust_main_invoice.pm +FS/cust_pay.pm +FS/cust_bill_event.pm +FS/cust_bill_pay.pm +FS/cust_pay_batch.pm +FS/cust_pay_refund.pm +FS/cust_pkg.pm +FS/cust_refund.pm +FS/cust_credit_refund.pm +FS/cust_svc.pm +FS/h_Common.pm +FS/h_cust_bill.pm +FS/h_cust_svc.pm +FS/h_cust_tax_exempt.pm +FS/h_domain_record.pm +FS/h_svc_acct.pm +FS/h_svc_broadband.pm +FS/h_svc_domain.pm +FS/h_svc_external.pm +FS/h_svc_forward.pm +FS/h_svc_www.pm +FS/part_bill_event.pm +FS/payinfo_Mixin.pm +FS/export_svc.pm +FS/part_export.pm +FS/part_export_option.pm +FS/part_export/acct_sql.pm +FS/part_export/apache.pm +FS/part_export/bind.pm +FS/part_export/bind_slave.pm +FS/part_export/bsdshell.pm +FS/part_export/communigate_pro.pm +FS/part_export/communigate_pro_singledomain.pm +FS/part_export/cp.pm +FS/part_export/cyrus.pm +FS/part_export/domain_shellcommands.pm +FS/part_export/forward_shellcommands.pm +FS/part_export/http.pm +FS/part_export/infostreet.pm +FS/part_export/ldap.pm +FS/part_export/null.pm +FS/part_export/radiator.pm +FS/part_export/router.pm +FS/part_export/shellcommands.pm +FS/part_export/shellcommands_withdomain.pm +FS/part_export/sqlmail.pm +FS/part_export/sqlradius.pm +FS/part_export/sysvshell.pm +FS/part_export/textradius.pm +FS/part_export/vpopmail.pm +FS/part_export/www_shellcommands.pm +FS/part_pkg.pm +FS/part_pkg_option.pm +FS/part_pkg/flat.pm +FS/part_pkg/flat_comission.pm +FS/part_pkg/flat_comission_cust.pm +FS/part_pkg/flat_comission_pkg.pm +FS/part_pkg/flat_delayed.pm +FS/part_pkg/prorate.pm +FS/part_pkg/sesmon_hour.pm +FS/part_pkg/sesmon_minute.pm +FS/part_pkg/sql_external.pm +FS/part_pkg/sql_generic.pm +FS/part_pkg/sqlradacct_hour.pm +FS/part_pkg/subscription.pm +FS/part_pkg/voip_sqlradacct.pm +FS/part_pkg/voip_cdr.pm +FS/part_pkg/base_rate.pm +FS/part_pkg/base_delayed.pm +FS/part_pop_local.pm +FS/part_referral.pm +FS/part_svc.pm +FS/part_svc_column.pm +FS/part_svc_router.pm +FS/part_virtual_field.pm +FS/payby.pm +FS/pkg_class.pm +FS/pkg_svc.pm +FS/rate.pm +FS/rate_detail.pm +FS/rate_region.pm +FS/rate_prefix.pm +FS/reg_code.pm +FS/reg_code_pkg.pm +FS/svc_Common.pm +FS/svc_acct.pm +FS/svc_acct_pop.pm +FS/svc_broadband.pm +FS/svc_domain.pm +FS/svc_external.pm +FS/router.pm +FS/type_pkgs.pm +FS/nas.pm +FS/port.pm +FS/session.pm +FS/domain_record.pm +FS/prepay_credit.pm +FS/svc_www.pm +FS/svc_forward.pm +FS/raddb.pm +FS/radius_usergroup.pm +FS/queue.pm +FS/queue_arg.pm +FS/queue_depend.pm +FS/msgcat.pm +FS/cust_tax_exempt.pm +FS/cust_tax_exempt_pkg.pm +FS/clientapi_session.pm +FS/clientapi_session_field.pm +t/agent.t +t/agent_type.t +t/AccessRight.t +t/CGI.t +t/InitHandler.t +t/ClientAPI.t +t/ClientAPI_SessionCache.t +t/Conf.t +t/ConfItem.t +t/Cron-backup.t +t/Cron-bill.t +t/Cron-vacuum.t +t/Daemon.t +t/Misc.t +t/Record.t +t/Report.t +t/Report-Table.t +t/Report-Table-Monthly.t +t/UID.t +t/Msgcat.t +t/SearchCache.t +t/cust_bill.t +t/cust_bill_event.t +t/cust_bill_pay.t +t/cust_bill_pkg.t +t/cust_bill_pkg_detail.t +t/cust_credit.t +t/cust_credit_bill.t +t/cust_credit_refund.t +t/cust_main.t +t/cust_main_Mixin.t +t/cust_main_county.t +t/cust_main_invoice.t +t/cust_pay.t +t/cust_pay_batch.t +t/cust_pay_refund.t +t/cust_pkg.t +t/cust_refund.t +t/cust_svc.t +t/h_cust_bill.t +t/h_cust_svc.t +t/h_cust_tax_exempt.t +t/h_Common.t +t/h_cust_svc.t +t/h_domain_record.t +t/h_svc_acct.t +t/h_svc_broadband.t +t/h_svc_domain.t +t/h_svc_external.t +t/h_svc_forward.t +t/h_svc_www.t +t/cust_tax_exempt.t +t/cust_tax_exempt_pkg.t +t/domain_record.t +t/nas.t +t/part_bill_event.t +t/export_svc.t +t/part_export.t +t/part_export_option.t +t/part_export-acct_sql.t +t/part_export-apache.t +t/part_export-bind.t +t/part_export-bind_slave.t +t/part_export-bsdshell.t +t/part_export-communigate_pro.t +t/part_export-communigate_pro_singledomain.t +t/part_export-cp.t +t/part_export-cyrus.t +t/part_export-domain_shellcommands.t +t/part_export-forward_shellcommands.t +t/part_export-http.t +t/part_export-infostreet.t +t/part_export-ldap.t +t/part_export-null.t +t/part_export-passwdfile.t +t/part_export-postfix.t +t/part_export-radiator.t +t/part_export-router.t +t/part_export-shellcommands.t +t/part_export-shellcommands_withdomain.t +t/part_export-sqlmail.t +t/part_export-sqlradius.t +t/part_export-sysvshell.t +t/part_export-textradius.t +t/part_export-vpopmail.t +t/part_export-www_shellcommands.t +t/part_pkg.t +t/part_pkg_option.t +t/part_pkg-flat.t +t/part_pkg-flat_comission.t +t/part_pkg-flat_comission_cust.t +t/part_pkg-flat_comission_pkg.t +t/part_pkg-flat_delayed.t +t/part_pkg-prorate.t +t/part_pkg-sesmon_hour.t +t/part_pkg-sesmon_minute.t +t/part_pkg-sql_external.t +t/part_pkg-sql_generic.t +t/part_pkg-sqlradacct_hour.t +t/part_pkg-subscription.t +t/part_pkg-voip_sqlradacct.t +t/part_pkg-voip_cdr.t +t/part_pop_local.t +t/part_referral.t +t/part_svc.t +t/part_svc_column.t +t/payby.t +t/payinfo_Mixin.t +t/pkg_class.t +t/pkg_svc.t +t/port.t +t/prepay_credit.t +t/rate.t +t/rate_detail.t +t/rate_region.t +t/rate_prefix.t +t/radius_usergroup.t +t/reg_code.t +t/reg_code_pkg.t +t/session.t +t/svc_acct.t +t/svc_acct_pop.t +t/svc_broadband.t +t/svc_Common.t +t/svc_domain.t +t/svc_external.t +t/svc_forward.t +t/svc_www.t +t/type_pkgs.t +t/queue.t +t/queue_arg.t +t/queue_depend.t +t/msgcat.t +t/raddb.t +t/clientapi_session.t +t/clientapi_session_field.t +FS/payment_gateway.pm +t/payment_gateway.t +FS/payment_gateway_option.pm +t/payment_gateway_option.t +FS/option_Common.pm +t/option_Common.t +FS/agent_payment_gateway.pm +t/agent_payment_gateway.t +FS/banned_pay.pm +t/banned_pay.t +bin/freeside-prepaidd +FS/cdr.pm +t/cdr.t +FS/cdr_calltype.pm +t/cdr_calltype.t +FS/cdr_type.pm +t/cdr_type.t +FS/cdr_carrier.pm +t/cdr_carrier.t +FS/inventory_class.pm +t/inventory_class.t +FS/inventory_item.pm +t/inventory_item.t +FS/cdr_upstream_rate.pm +t/cdr_upstream_rate.t +FS/access_user.pm +t/access_user.t +FS/access_user_pref.pm +t/access_user_pref.t +FS/access_group.pm +t/access_group.t +FS/access_usergroup.pm +t/access_usergroup.t +FS/access_groupagent.pm +t/access_groupagent.t +FS/access_right.pm +t/access_right.t +FS/m2m_Common.pm +FS/pay_batch.pm +t/pay_batch.t +FS/ConfDefaults.pm +t/ConfDefaults.t +FS/m2name_Common.pm +FS/CurrentUser.pm +FS/svc_phone.pm +t/svc_phone.t +FS/h_svc_phone.pm +FS/cust_bill_pay_batch.pm +t/cust_bill_pay_batch.t +FS/cust_bill_pay_pkg.pm +t/cust_bill_pay_pkg.t +FS/cust_credit_bill_pkg.pm +t/cust_credit_bill_pkg.t +FS/registrar.pm +t/registrar.t +FS/svc_External_Common.pm +t/svc_External_Common.t +FS/svc_Parent_Mixin.pm +t/svc_Parent_Mixin.t +FS/cust_main_note.pm +t/cust_main_note.t +FS/cust_pkg_reason.pm +t/cust_pkg_reason.t +FS/reason.pm +t/reason.t +FS/reason_type.pm +t/reason_type.t +FS/pkg_referral.pm +t/pkg_referral.t +FS/part_event_option.pm +t/part_event_option.t +FS/part_event_condition.pm +t/part_event_condition.t +FS/part_event_condition_option.pm +t/part_event_condition_option.t +FS/part_event.pm +t/part_event.t +FS/cust_event.pm +t/cust_event.t +FS/part_event_condition_option_option.pm +t/part_event_condition_option_option.t +FS/cust_pkg_option.pm +t/cust_pkg_option.t +FS/conf.pm +t/conf.t +FS/acct_rt_transaction.pm +t/acct_rt_transaction.t +FS/cust_pay_pending.pm +t/cust_pay_pending.t +FS/part_pkg_taxclass.pm +t/part_pkg_taxclass.t diff --git a/FS/MANIFEST.SKIP b/FS/MANIFEST.SKIP new file mode 100644 index 000000000..ae335e78a --- /dev/null +++ b/FS/MANIFEST.SKIP @@ -0,0 +1 @@ +CVS/ diff --git a/FS/Makefile.PL b/FS/Makefile.PL new file mode 100644 index 000000000..1647f8eef --- /dev/null +++ b/FS/Makefile.PL @@ -0,0 +1,10 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'NAME' => 'FS', + 'VERSION_FROM' => 'FS.pm', # finds $VERSION + 'EXE_FILES' => [ glob 'bin/*' ], + 'INSTALLSCRIPT' => '/usr/local/bin', + 'INSTALLSITEBIN' => '/usr/local/bin', +); diff --git a/FS/bin/freeside-addgroup b/FS/bin/freeside-addgroup new file mode 100755 index 000000000..7b30f7d95 --- /dev/null +++ b/FS/bin/freeside-addgroup @@ -0,0 +1,50 @@ +#!/usr/bin/perl + +use strict; +use vars qw($opt_s); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::CurrentUser; +use FS::AccessRight; +use FS::access_group; +use FS::access_right; +use FS::access_groupagent; + +getopts("s"); +my $user = shift or die &usage; #just for adminsuidsetup +my $group = shift or die &usage; + +$FS::CurrentUser::upgrade_hack = 1; +#adminsuidsetup $rootuser; +adminsuidsetup $user; + +my $access_group = new FS::access_group { 'groupname' => $group }; +my $error = $access_group->insert; +die $error if $error; + +if ( $opt_s ) { + foreach my $rightname ( FS::AccessRight->rights ) { + my $access_right = new FS::access_right { + 'righttype' => 'FS::access_group', + 'rightobjnum' => $access_group->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' => $access_group->groupnum, + 'agentnum' => $agent->agentnum, + }; + my $aga_error = $access_groupagent->insert; + die $aga_error if $aga_error; + } +} + +sub usage { + die "Usage:\n\n freeside-addgroup [ -s ] username groupname" +} + diff --git a/FS/bin/freeside-addoutsource b/FS/bin/freeside-addoutsource new file mode 100644 index 000000000..9cb12195a --- /dev/null +++ b/FS/bin/freeside-addoutsource @@ -0,0 +1,32 @@ +#!/bin/sh + +domain=$1 + +FREESIDE_CONF=%%%FREESIDE_CONF%%% +FREESIDE_CACHE=%%%FREESIDE_CACHE%%% +FREESIDE_EXPORT=%%%FREESIDE_EXPORT%%% + +#without this, [a-z]* matches CVS/, the copy doesn't return a sucessful error +# status, and the rest of the commands aren't run +export LANG=C + +createdb $domain && \ +\ +mkdir $FREESIDE_CONF/conf.DBI:Pg:dbname=$domain && \ +\ +chown freeside $FREESIDE_CONF/conf.DBI:Pg:dbname=$domain && \ +\ +cp /home/ivan/freeside/conf/[a-z]* $FREESIDE_CONF/conf.DBI:Pg:dbname=$domain && \ +\ +touch $FREESIDE_CONF/conf.DBI:Pg:dbname=$domain/secrets && \ +\ +chown freeside $FREESIDE_CONF/conf.DBI:Pg:dbname=$domain/secrets && \ +\ +chmod 600 $FREESIDE_CONF/conf.DBI:Pg:dbname=$domain/secrets && \ +\ +echo -e "DBI:Pg:dbname=$domain\nfreeside\n" >$FREESIDE_CONF/conf.DBI:Pg:dbname=$domain/secrets && \ +\ +mkdir $FREESIDE_CACHE/counters.DBI:Pg:dbname=$domain && \ +mkdir $FREESIDE_CACHE/cache.DBI:Pg:dbname=$domain && \ +mkdir $FREESIDE_EXPORT/export.DBI:Pg:dbname=$domain + diff --git a/FS/bin/freeside-addoutsourceuser b/FS/bin/freeside-addoutsourceuser new file mode 100644 index 000000000..cbe792acc --- /dev/null +++ b/FS/bin/freeside-addoutsourceuser @@ -0,0 +1,18 @@ +#!/bin/sh + +username=$1 +domain=$2 +password=$3 +realdomain=$4 +FREESIDE_CONF=%%%FREESIDE_CONF%%% + +freeside-adduser -s conf.DBI:Pg:dbname=$domain/secrets \ + -n \ + $username #2>/dev/null + +[ -e $FREESIDE_CONF/dbdef.DBI:Pg:dbname=$domain ] \ + || ( freeside-setup -d $realdomain -u $username ) + +freeside-adduser -g 1 $username + +htpasswd -b $FREESIDE_CONF/htpasswd $username $password diff --git a/FS/bin/freeside-adduser b/FS/bin/freeside-adduser new file mode 100644 index 000000000..237e29ef8 --- /dev/null +++ b/FS/bin/freeside-adduser @@ -0,0 +1,119 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($opt_s $opt_g $opt_n); +use Fcntl qw(:flock); +use Getopt::Std; + +my $FREESIDE_CONF = "%%%FREESIDE_CONF%%%"; + +getopts("s:g:n"); +my $user = shift or die &usage; + +if ( $opt_s ) { + + #if ( -e "$FREESIDE_CONF/mapsecrets" ) { + # open(MAPSECRETS,"<$FREESIDE_CONF/mapsecrets") + # or die "can't open $FREESIDE_CONF/mapsecrets: $!"; + # while (<MAPSECRETS>) { + # /^(\S+) / or die "unparsable line in mapsecrets: $_"; + # die "user $user already exists\n" if $user eq $1; + # } + # close MAPSECRETS; + #} + + #insert new entry before a wildcard... + open(MAPSECRETS,"<$FREESIDE_CONF/mapsecrets") + and flock(MAPSECRETS,LOCK_EX) + or die "can't open $FREESIDE_CONF/mapsecrets: $!"; + open(NEW,">$FREESIDE_CONF/mapsecrets.new") + or die "can't open $FREESIDE_CONF/mapsecrets.new: $!"; + while(<MAPSECRETS>) { + if ( /^\*\s/ ) { + print NEW "$user $opt_s\n"; + } + print NEW $_; + } + close MAPSECRETS or die "can't close $FREESIDE_CONF/mapsecrets: $!"; + close NEW or die "can't close $FREESIDE_CONF/mapsecrets.new: $!"; + rename("$FREESIDE_CONF/mapsecrets.new", "$FREESIDE_CONF/mapsecrets") + or die "can't move mapsecrets.new into place: $!"; + +} + +### + +exit if $opt_n; + +### + +use FS::UID qw(adminsuidsetup); +use FS::CurrentUser; +use FS::access_user; +use FS::access_usergroup; + +$FS::CurrentUser::upgrade_hack = 1; +#adminsuidsetup $rootuser; +adminsuidsetup $user; + +my $access_user = new FS::access_user { + 'username' => $user, + '_password' => 'notyet', + 'first' => 'Firstname', # $opt_f || + 'last' => 'Lastname', # $opt_l || +}; +my $au_error = $access_user->insert; +die $au_error if $au_error; + +if ( $opt_g ) { + + my $access_usergroup = new FS::access_usergroup { + 'usernum' => $access_user->usernum, + 'groupnum' => $opt_g, + }; + my $aug_error = $access_usergroup->insert; + die $aug_error if $aug_error; + +} + +### + +sub usage { + die "Usage:\n\n freeside-adduser [ -n ] [ -s ] [ -g groupnum ] username [ password ]" +} + +=head1 NAME + +freeside-adduser - Command line interface to add (freeside) users. + +=head1 SYNOPSIS + + freeside-adduser [ -n ] [ -s ] [ -g groupnum ] username [ password ] + +=head1 DESCRIPTION + +Adds a user to the Freeside billing system. This is for adding users (internal +sales/tech folks) to the web interface, not for adding customer accounts. + +This functionality is now available in the web interface as well, under +B<Configuration | Employees | View/Edit employees>. + + -g: initial groupnum + + Development/multi-DB options: + + -s: alternate secrets file + + -n: no ACL added, for bootstrapping + +=head1 NOTE + +No explicit htpasswd options are available in 1.7 - passwordsa are now +maintained automatically. + +=head1 SEE ALSO + +Base Freeside documentation + +=cut + diff --git a/FS/bin/freeside-apply-credits b/FS/bin/freeside-apply-credits new file mode 100755 index 000000000..ea6a7bdd0 --- /dev/null +++ b/FS/bin/freeside-apply-credits @@ -0,0 +1,21 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw( $user $cust_main @customers ); +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_main; + +$user = shift or die &usage; +&adminsuidsetup( $user ); + +my @customers = qsearch('cust_main', {} ); +die "No customers" unless (scalar(@customers) > 0); + +foreach $cust_main (@customers) { + print "Applying credits for customer #". $cust_main->custnum; + $cust_main->apply_credits; +} + + + diff --git a/FS/bin/freeside-count-active-customers b/FS/bin/freeside-count-active-customers new file mode 100755 index 000000000..759085a73 --- /dev/null +++ b/FS/bin/freeside-count-active-customers @@ -0,0 +1,17 @@ +#!/bin/sh + +domain=$1 + +echo "\t +select count(*) from cust_main where + 0 < ( SELECT COUNT(*) FROM cust_pkg + WHERE cust_pkg.custnum = cust_main.custnum + AND ( cust_pkg.cancel IS NULL + OR cust_pkg.cancel = 0 + ) + ) + OR 0 = ( SELECT COUNT(*) FROM cust_pkg + WHERE cust_pkg.custnum = cust_main.custnum + ); +" | psql -U freeside -q $domain | head -1 + diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily new file mode 100755 index 000000000..13079b4f9 --- /dev/null +++ b/FS/bin/freeside-daily @@ -0,0 +1,104 @@ +#!/usr/bin/perl -w + +use strict; +use Getopt::Std; +use FS::UID qw(adminsuidsetup); + +&untaint_argv; #what it sounds like (eww) +use vars qw(%opt); +getopts("p:a:d:vl:sy:nm", \%opt); + +my $user = shift or die &usage; +adminsuidsetup $user; + +use FS::Cron::bill qw(bill); +bill(%opt); + +#what to do about the below when using -m? that is the question. + +use FS::Cron::notify qw(notify_flat_delay); +notify_flat_delay(%opt); + +use FS::Cron::expire_user_pref qw(expire_user_pref); +expire_user_pref(); + +use FS::Cron::vacuum qw(vacuum); +vacuum(); + +use FS::Cron::backup qw(backup_scp); +backup_scp(); + +### +# subroutines +### + +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + # Date::Parse + $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-daily [ -d 'date' ] user [ custnum custnum ... ]\n"; +} + +### +# documentation +### + +=head1 NAME + +freeside-daily - Run daily billing and invoice collection events. + +=head1 SYNOPSIS + + freeside-daily [ -d 'date' ] [ -y days ] [ -p 'payby' ] [ -a agentnum ] [ -s ] [ -v ] [ -l level ] [ -m ] user [ custnum custnum ... ] + +=head1 DESCRIPTION + +Bills customers and runs invoice collection events. Should be run from +crontab daily. + +Bills customers. Searches for customers who are due for billing and calls +the bill and collect methods of a cust_main object. See L<FS::cust_main>. + + -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 + + -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. + +user: From the mapsecrets file - see config.html from the base documentation + +custnum: if one or more customer numbers are specified, only bills those +customers. Otherwise, bills all customers. + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::cust_main>, config.html from the base documentation + +=cut + diff --git a/FS/bin/freeside-dbdef-create b/FS/bin/freeside-dbdef-create new file mode 100755 index 000000000..a04f42521 --- /dev/null +++ b/FS/bin/freeside-dbdef-create @@ -0,0 +1,47 @@ +#!/usr/bin/perl -Tw + +use strict; +use DBI; +use DBIx::DBSchema 0.26; +use FS::UID qw(adminsuidsetup datasrc driver_name); +use FS::Schema; + +my $user = shift or die &usage; + +$FS::Schema::setup_hack = 1; +$FS::CurrentUser::upgrade_hack = 1; +my($dbh)=adminsuidsetup $user; + +#needs to match FS::Record +my($dbdef_file) = "%%%FREESIDE_CONF%%%/dbdef.". datasrc; + +my $dbdef = new_native DBIx::DBSchema $dbh; + +#print $dbdef->pretty_print; + +#important +$dbdef->save($dbdef_file); + +sub usage { + die "Usage:\n dbdef-create user\n"; +} + +=head1 NAME + +freeside-dbdef-create - Recreate database schema cache + +=head1 SYNOPSIS + + freeside-dbdef-create user + +=head1 DESCRIPTION + +Reverse engineers the database schema and recreates the dbdef cache file. + +=head1 SEE ALSO + +L<DBIx::DBSchema> + +=cut + +1; diff --git a/FS/bin/freeside-delete-addr_blocks b/FS/bin/freeside-delete-addr_blocks new file mode 100755 index 000000000..a7e99766a --- /dev/null +++ b/FS/bin/freeside-delete-addr_blocks @@ -0,0 +1,31 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw( $user $block @blocks ); +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::addr_block; +use FS::svc_broadband; + +$user = shift or die &usage; +&adminsuidsetup( $user ); + +@blocks = qsearch('addr_block', {} ); +die "No address blocks" unless (scalar(@blocks) > 0); + +foreach $block (@blocks) { + my @devices = qsearch('svc_broadband', { 'blocknum' => $block->blocknum } ); + if (@devices) { + print "Skipping block " . $block->ip_gateway . " / " . $block->ip_netmask; + print "\n"; + }else{ + print "Deleting block " . $block->ip_gateway . " / " . $block->ip_netmask; + print "\n"; + $block->delete; + } +} + + +sub usage { + "Usage:\n freeside-delete-addr_blocks user \n"; +} diff --git a/FS/bin/freeside-deloutsource b/FS/bin/freeside-deloutsource new file mode 100644 index 000000000..afc3a0118 --- /dev/null +++ b/FS/bin/freeside-deloutsource @@ -0,0 +1,14 @@ +#!/bin/sh + +domain=$1 +FREESIDE_CONF=%%%FREESIDE_CONF%%% +FREESIDE_CACHE=%%%FREESIDE_CACHE%%% +FREESIDE_EXPORT=%%%FREESIDE_EXPORT%%% + +dropdb $domain && \ +rm -rf $FREESIDE_CONF/conf.DBI:Pg:host=localhost\;dbname=$domain && \ +rm -rf $FREESIDE_CACHE/counters.DBI:Pg:host=localhost\;dbname=$domain && \ +rm -rf $FREESIDE_CACHE/cache.DBI:Pg:host=localhost\;dbname=$domain && \ +rm -rf $FREESIDE_EXPORT/export.DBI:Pg:host=localhost\;dbname=$domain && \ +rm $FREESIDE_CONF/dbdef.DBI:Pg:host=localhost\;dbname=$domain + diff --git a/FS/bin/freeside-deloutsourceuser b/FS/bin/freeside-deloutsourceuser new file mode 100644 index 000000000..dc4ff9cdc --- /dev/null +++ b/FS/bin/freeside-deloutsourceuser @@ -0,0 +1,6 @@ +#!/bin/sh + +username=$1 + +freeside-deluser -h %%%FREESIDE_CONF%%%/htpasswd $username 2>/dev/null + diff --git a/FS/bin/freeside-deluser b/FS/bin/freeside-deluser new file mode 100644 index 000000000..a2a361a83 --- /dev/null +++ b/FS/bin/freeside-deluser @@ -0,0 +1,64 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($opt_h); +use Fcntl qw(:flock); +use Getopt::Std; + +my $FREESIDE_CONF = "%%%FREESIDE_CONF%%%"; + +getopts("h:"); +my $user = shift or die &usage; + +if ( $opt_h ) { + open(HTPASSWD,"<$opt_h") + and flock(HTPASSWD,LOCK_EX) + or die "can't open $opt_h: $!"; + open(HTPASSWD_TMP,">$opt_h.tmp") or die "can't open $opt_h.tmp: $!"; + while (<HTPASSWD>) { + print HTPASSWD_TMP $_ unless /^$user:/; + } + close HTPASSWD_TMP; + rename "$opt_h.tmp", "$opt_h" or die $!; + flock(HTPASSWD,LOCK_UN); + close HTPASSWD; +} + +open(MAPSECRETS,"<$FREESIDE_CONF/mapsecrets") + and flock(MAPSECRETS,LOCK_EX) + or die "can't open $FREESIDE_CONF/mapsecrets: $!"; +open(MAPSECRETS_TMP,">>$FREESIDE_CONF/mapsecrets.tmp") + or die "can't open $FREESIDE_CONF/mapsecrets.tmp: $!"; +while (<MAPSECRETS>) { + print MAPSECRETS_TMP $_ unless /^$user\s/; +} +close MAPSECRETS_TMP; +rename "$FREESIDE_CONF/mapsecrets.tmp", "$FREESIDE_CONF/mapsecrets" or die $!; +flock(MAPSECRETS,LOCK_UN); +close MAPSECRETS; + +sub usage { + die "Usage:\n\n freeside-deluser [ -h htpasswd_file ] username" +} + +=head1 NAME + +freeside-deluser - Command line interface to add (freeside) users. + +=head1 SYNOPSIS + + freeside-deluser [ -h htpasswd_file ] username + +=head1 DESCRIPTION + +Adds a user to the Freeside billing system. This is for adding users (internal +sales/tech folks) to the web interface, not for adding customer accounts. + + -h: Also delete from the given htpasswd filename + +=head1 SEE ALSO + +L<freeside-adduser>, L<htpasswd>(1), base Freeside documentation + +=cut + diff --git a/FS/bin/freeside-disable-reasons b/FS/bin/freeside-disable-reasons new file mode 100755 index 000000000..0af460919 --- /dev/null +++ b/FS/bin/freeside-disable-reasons @@ -0,0 +1,64 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($opt_t $opt_e); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::reason_type; +use FS::reason; + +getopts('t:e'); + +my $user = shift or die &usage; +adminsuidsetup $user; + +die &usage + unless ($opt_t); + +$FS::Record::nowarn_identical = 1; + +my @reason = (); +if ( $opt_t ) { + $opt_t =~ /^(\d+)$/ or die "invalid reason_type"; + @reason = qsearch('reason', { reason_type => $1 } ); + die "no reasons found\n" unless @reason; +} else { + die "no reason_type specified\n"; +} + +foreach my $reason ( @reason ) { + if ( $opt_e ) { + $reason->disabled(''); + }else{ + $reason->disabled('Y'); + } + my $error = $reason->replace + if $reason->modified; + die $error if $error; +} + + +sub usage { + die "Usage:\n\n freeside-disable-reasons -t reason_type [ -e ] user\n"; +} + +=head1 NAME + +freeside-disable-reasons - Command line tool to set the disabled column for reasons + +=head1 SYNOPSIS + + freeside-disable-reasons -t reason_type [ -e ] user + +=head1 DESCRIPTION + + Disables the reasons of the specified reason type. + Enables instead if -e is specified. + +=head1 SEE ALSO + +L<FS::reason>, L<FS::reason_type> + +=cut + diff --git a/FS/bin/freeside-email b/FS/bin/freeside-email new file mode 100755 index 000000000..7a93f78ee --- /dev/null +++ b/FS/bin/freeside-email @@ -0,0 +1,55 @@ +#!/usr/bin/perl -Tw + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Conf; +use FS::Record qw(qsearch); +use FS::svc_acct; + +&untaint_argv; #what it sounds like (eww) +my $user = shift or die &usage; + +adminsuidsetup $user; + +my $conf = new FS::Conf; + +my @svc_acct = qsearch('svc_acct', {}); +my @emails = map $_->email, @svc_acct; + +print join("\n", @emails), "\n"; + +# subroutines + +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + # Date::Parse + $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-email user\n"; +} + +=head1 NAME + +freeside-email - Prints email addresses of all users on STDOUT + +=head1 SYNOPSIS + + freeside-email user + +=head1 DESCRIPTION + +Prints the email addresses of all customers on STDOUT, separated by newlines. + +user: From the mapsecrets file - see config.html from the base documentation + +=head1 BUGS + +=head1 SEE ALSO + +=cut + diff --git a/FS/bin/freeside-expiration-alerter b/FS/bin/freeside-expiration-alerter new file mode 100755 index 000000000..ffd75f9a5 --- /dev/null +++ b/FS/bin/freeside-expiration-alerter @@ -0,0 +1,226 @@ +#!/usr/bin/perl -Tw + +use strict; +use Date::Format; +use Time::Local; +use Text::Template; +use Getopt::Std; +use Net::SMTP; +use Mail::Header; +use Mail::Internet; +use FS::Conf; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_main; + +use vars qw($smtpmachine @body); + +#hush, perl! +$FS::alerter::_template::first = ""; +$FS::alerter::_template::last = ""; +$FS::alerter::_template::company = ""; +$FS::alerter::_template::payby = ""; +$FS::alerter::_template::expdate = ""; + +# Set the mail program and other variables +my $mail_sender = "billing\@mydomain.tld"; # or invoice_from if available +my $failure_recipient = "postmaster"; # or invoice_from if available +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; + +&untaint_argv; #what it sounds like (eww) + +#we're at now now (and later). +my($_date)= $^T; + +# Get the current month +my ($sec,$min,$hour,$mday,$mon,$year) = + (localtime($_date) )[0,1,2,3,4,5]; +$mon++; + +# Login to the database +my $user = shift or die &usage; +adminsuidsetup $user; + +# Get the needed configuration files +my $conf = new FS::Conf; +$smtpmachine = $conf->config('smtpmachine'); +$mail_sender = $conf->config('invoice_from') + if $conf->exists('invoice_from'); +$failure_recipient = $conf->config('invoice_from') + if $conf->exists('invoice_from'); + + +my(@customers)=qsearch('cust_main',{}); +if (scalar(@customers) == 0) +{ + exit 1; +} + +# Prepare for sending email + +$ENV{MAILADDRESS} = $mail_sender; +my $header = new Mail::Header ( [ + "From: Account Processor", + "To: $failure_recipient", + "Sender: $mail_sender", + "Reply-To: $mail_sender", + "Subject: Unnotified Billing Arrangement Expirations", +] ); + +my @alerter_template = $conf->config('alerter_template') + 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 new Text::Template object: Text::Template::ERROR"; +$alerter->compile() or die "can't compile template: Text::Template::ERROR"; + +# Now I can start looping +foreach my $customer (@customers) +{ + my $paydate = $customer->getfield('paydate'); + next if $paydate =~ /^\s*$/; #skip empty expiration dates + + my $custnum = $customer->getfield('custnum'); + my $first = $customer->getfield('first'); + my $last = $customer->getfield('last'); + my $company = $customer->getfield('company'); + my $payby = $customer->getfield('payby'); + my $payinfo = $customer->getfield('payinfo'); + my $daytime = $customer->getfield('daytime'); + my $night = $customer->getfield('night'); + + 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') { + ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++); + $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear); + $expire_time--; + } + + if (($expire_time < $_date + $warning_time && + $expire_time > $_date + $warning_time - $window_time) || + ($expire_time < $_date + $urgent_time && + $expire_time > $_date + $urgent_time - $window_time) || + ($expire_time < $_date + $panic_time && + $expire_time > $_date + $panic_time - $window_time)) { + + + + my @packages = $customer->ncancelled_pkgs; + if (scalar(@packages) != 0) { + my @invoicing_list = $customer->invoicing_list; + if ( grep { $_ ne 'POST' } @invoicing_list ) { + my $header = new Mail::Header ( [ + "From: $mail_sender", + "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ), + "Sender: $mail_sender", + "Reply-To: $mail_sender", + "Date: ". time2str("%a, %d %b %Y %X %z", time), + "Subject: Billing Arrangement Expiration", + ] ); + $FS::alerter::_template::first = $first; + $FS::alerter::_template::last = $last; + $FS::alerter::_template::company = $company; + if ($payby eq 'CARD' || $payby eq 'DCRD') { + $FS::alerter::_template::payby = "credit card (" . + substr($payinfo, 0, 2) . "xxxxxxxxxx" . + substr($payinfo, -4) . ")"; + }elsif ($payby eq 'COMP') { + $FS::alerter::_template::payby = "complimentary account"; + }else{ + $FS::alerter::_template::payby = "current method"; + } + $FS::alerter::_template::expdate = $expire_time; + + $FS::alerter::_template::company_name = $conf->config('company_name'); + $FS::alerter::_template::company_address = + join("\n", $conf->config('company_address') ). "\n"; + + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => [ $alerter->fill_in( PACKAGE => 'FS::alerter::_template' ) ], + ); + $!=0; + $message->smtpsend( Host => $smtpmachine ) + or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) + or die "Can't send expiration email: $!"; + + } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) { + push @body, sprintf(qq{%5d %-32.32s %4s %10s %12s %12s}, + $custnum, + $first . " " . $last . " " . $company, + $payby, + $paydate, + $daytime, + $night); + } + } + } +} + +# Now I need to send EMAIL +if (scalar(@body)) { + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => [ (@body) ], + ); + $!=0; + $message->smtpsend( Host => $smtpmachine ) + or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) + or die "can't send alerter failure email to $failure_recipient". + " via server $smtpmachine with SMTP: $!"; +} + +# subroutines +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + $ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal argument \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-expiration-alerter user\n"; +} + +=head1 NAME + +freeside-expiration-alerter - Emails notifications of credit card expirations. + +=head1 SYNOPSIS + + freeside-expiration-alerter user + +=head1 DESCRIPTION + +Emails customers notice that their credit card or other billing arrangement +is about to expire. Usually run as a cron job. + +user: From the mapsecrets file - see config.html from the base documentation + +=head1 BUGS + +Yes..... Use at your own risk. No guarantees or warrantees of any +kind apply to this program. Parts of this program are hacked from +other GNU licensed software created mainly by Ivan Kohler. + +This is released under the GNU Public License. See www.gnu.org +for more information regarding this license. + +=head1 SEE ALSO + +L<FS::cust_main>, config.html from the base documentation + +=head1 AUTHOR + +Jeff Finucane <jeff@cmh.net> + +=cut + + diff --git a/FS/bin/freeside-fetch b/FS/bin/freeside-fetch new file mode 100755 index 000000000..89a4f29af --- /dev/null +++ b/FS/bin/freeside-fetch @@ -0,0 +1,89 @@ +#!/usr/bin/perl -Tw + +use strict; +use LWP::UserAgent; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearchs); +use FS::Misc qw(send_email); + +my $user = shift or die &usage; +my $employeelist = shift or die &usage; +my $url = shift or die &usage; +adminsuidsetup $user; + +my @employees = split ',', $employeelist; + +foreach my $employee (@employees) { + + $employee =~ /^(\w+)$/; + + my $access_user = qsearchs( 'access_user', { 'username' => $1 } ); + unless ($access_user) { + warn "Can't find employee $employee... skipping"; + next; + } + + my $email_address = $access_user->option('email_address'); + unless ($email_address) { + warn "No email address for $employee... skipping"; + next; + } + + no warnings 'redefine'; + local *LWP::UserAgent::get_basic_credentials = sub { + return ($access_user->username, $access_user->_password); + }; + + my $ua = new LWP::UserAgent; + $ua->agent("FreesideFetcher/0.1 " . $ua->agent); + + my $req = new HTTP::Request GET => $url; + my $res = $ua->request($req); + + my %options = ( 'from' => $email_address, + 'to' => $email_address, + 'subject' => 'subject', + 'body' => $res->content, + ); + + $options{'content-type'} = $res->content_type + if $res->content_type; + $options{'content-encoding'} = $res->content_encoding + if $res->content_encoding; + + if ($res->is_success) { + send_email %options; + }else{ + warn "fetching $url failed for $employee: " . $res->status_line; + } +} + +sub usage { + die "Usage:\n\n freeside-fetch user employee[,employee ...] url\n\n"; +} + +=head1 NAME + +freeside-fetch - Send a freeside page to a list of employees. + +=head1 SYNOPSIS + + freeside-fetch user employee[,employee ...] url + +=head1 DESCRIPTION + + Fetches a web page specified by url as if employee and emails it to + employee. Useful when run out of cron to send freeside web pages. + + user: From the mapsecrets file - a user with access to the freeside database + + employee: the username of an employee to receive the emailed page. May be a comma separated list + + url: the web page to be received + +=head1 BUGS + + Can leak employee usernames and passwords if requested to access inappropriate urls. + +=cut + diff --git a/FS/bin/freeside-history-requeue b/FS/bin/freeside-history-requeue new file mode 100755 index 000000000..77a4332a3 --- /dev/null +++ b/FS/bin/freeside-history-requeue @@ -0,0 +1,100 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($opt_j $opt_d); +use Getopt::Std; +use Date::Parse; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::queue; + +getopts('j:d'); + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $start = shift or die &usage; +my $end = shift or die &usage; + +$start = str2time($start) unless $start =~ /^(\d+)$/; +$end = str2time($end) unless $end =~ /^(\d+)$/; + +my $extra_sql = "AND history_date >= $start AND history_date <= $end"; + +my $hashref = { 'history_action' => 'insert' }; + +$hashref->{'job'} = $opt_j if $opt_j; + +my @h_queue = qsearch({ + 'table' => 'h_queue', + 'hashref' => $hashref, + 'extra_sql' => $extra_sql, +}); + +my $num = 0; + +foreach my $h_queue (@h_queue) { + + my @queue_args = qsearch({ + 'table' => 'h_queue_arg', + 'hashref' => { 'history_action' => 'insert', + 'jobnum' => $h_queue->jobnum, + }, + 'order_by' => 'argnum', + }); + + my @args = map { + my $arg = $_->arg; + $arg =~ s/^db\.suicidegirls\.com$/sg-account/; + $arg; + } @queue_args; + + my $queue = new FS::queue { + map { $_ => $h_queue->$_() } + qw( job _date status statustext svcnum ) + }; + + if ( $opt_d ) { #dry run + print "requeueing job: ". join(' ', @args). "\n"; + my $error = $queue->check; + die "error requeueing job ". $h_queue->jobnum. ": $error" if $error; + } else { + print "requeueing job: ". join(' ', @args). "\n"; + my $error = $queue->insert(@args); + #warn "error requeueing job ". $h_queue->jobnum. ": $error\n" if $error; + print "error requeueing job ". $h_queue->jobnum. ": $error\n" if $error; + } + + $num++; + +} + +print "requeued $num jobs\n"; + +sub usage { + die "Usage:\n\n freeside-history-requeue user start_timestamp end_timestamp\n"; +} + +=head1 NAME + +freeside-history-requeue - Command line tool to re-trigger export jobs for existing services + +=head1 SYNOPSIS + + freeside-history-requeue [ -j job ] [ -d ] user start_timestamp end_timestamp + +=head1 DESCRIPTION + + Re-queues all queued jobs for the specified time period. + + -j: specifies that only jobs with this job string are re-queued. + + -d: dry run + +=head1 SEE ALSO + +L<freeside-reexport>, L<freeside-sqlradius-reset>, L<FS::part_export> + +=cut + +1; diff --git a/FS/bin/freeside-init-config b/FS/bin/freeside-init-config new file mode 100755 index 000000000..fe4729c40 --- /dev/null +++ b/FS/bin/freeside-init-config @@ -0,0 +1,45 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw($opt_u $opt_f $opt_v); +use Getopt::Std; +use FS::UID qw(adminsuidsetup checkeuid dbh); +use FS::CurrentUser; +use FS::Record qw(qsearch); +use FS::Conf; + + +die "Not running uid freeside!" unless checkeuid(); + +getopts("u:vf"); +my $dir = shift or die &usage; + +$FS::CurrentUser::upgrade_hack = 1; +$FS::UID::AutoCommit = 0; +$FS::UID::callback_hack = 1; +adminsuidsetup $opt_u; #$user; + +$|=1; + +if (!scalar(qsearch('conf', {})) || $opt_f) { + my $error = FS::Conf::init_config($dir); + if ($error) { + warn "CONFIGURATION INITIALIZATION FAILED\n"; + dbh->rollback or die dbh->errstr; + die $error if $error; + } +} + +warn "Freeside database initialized - committing transaction\n" if $opt_v; + +dbh->commit or die dbh->errstr; +dbh->disconnect or die dbh->errstr; + +warn "Configuration initialization committed successfully\n" if $opt_v; + +sub usage { + die "Usage:\n freeside-init-config [ -v ] [ -f ] directory\n" + # [ -u user ] for devel/multi-db installs +} + +1; diff --git a/FS/bin/freeside-monthly b/FS/bin/freeside-monthly new file mode 100755 index 000000000..1e41b780e --- /dev/null +++ b/FS/bin/freeside-monthly @@ -0,0 +1,91 @@ +#!/usr/bin/perl -w + +use strict; +use Getopt::Std; +use FS::UID qw(adminsuidsetup); + +&untaint_argv; #what it sounds like (eww) +#use vars qw($opt_d $opt_v $opt_p $opt_a $opt_s $opt_y); +use vars qw(%opt); +getopts("p:a:d:vsy:", \%opt); + +my $user = shift or die &usage; +adminsuidsetup $user; + +use FS::Cron::bill qw(bill); +bill(%opt, 'check_freq'=>'1m' ); + +### +# subroutines +### + +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + # Date::Parse + $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-monthly [ -d 'date' ] user [ custnum custnum ... ]\n"; +} + +### +# documentation +### + +=head1 NAME + +freeside-monthly - Run monthly billing and invoice collection events. + +=head1 SYNOPSIS + + freeside-monthly [ -d 'date' ] [ -y days ] [ -p 'payby' ] [ -a agentnum ] [ -s ] [ -v ] user [ custnum custnum ... ] + +=head1 DESCRIPTION + +Bills customers and runs invoice collection events, for the alternate monthly +event chain. If you have defined monthly event checks, should be run from +crontab monthly. + +Bills customers. Searches for customers who are due for billing and calls +the bill and collect methods of a cust_main object. See L<FS::cust_main>. + + -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). + + -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 + + -s: re-charge setup fees + + -v: enable debugging + +user: From the mapsecrets file - see config.html from the base documentation + +custnum: if one or more customer numbers are specified, only bills those +customers. Otherwise, bills all customers. + +=head1 NOTE + +In most cases, you would use freeside-daily only and not freeside-monthly. +freeside-monthly would only be used in cases where you have events that can +only be run once each month, for example, batching invoices to a third-party +print/mail provider. + +=head1 BUGS + +=head1 SEE ALSO + +L<freeside-daily>, L<FS::cust_main>, config.html from the base documentation + +=cut + diff --git a/FS/bin/freeside-prepaidd b/FS/bin/freeside-prepaidd new file mode 100644 index 000000000..a68db3913 --- /dev/null +++ b/FS/bin/freeside-prepaidd @@ -0,0 +1,106 @@ +#!/usr/bin/perl -w + +use strict; +use FS::Daemon qw(daemonize1 drop_root logfile daemonize2 sigint sigterm); +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::cust_pkg; + +my $user = shift or die &usage; + +#daemonize1('freeside-sprepaidd', $user); #keep unique pid files w/multi installs +daemonize1('freeside-prepaidd'); + +drop_root(); + +adminsuidsetup($user); + +logfile( "/usr/local/etc/freeside/prepaidd-log.". $FS::UID::datasrc ); + +daemonize2(); + +#-- + +while (1) { + + foreach my $cust_pkg ( + qsearch( { + 'select' => 'cust_pkg.*, part_pkg.plan', + 'table' => 'cust_pkg', + 'addl_from' => 'LEFT JOIN part_pkg USING ( pkgpart )', + #'hashref' => { 'plan' => 'prepaid' },#should check part_pkg::is_prepaid + #'extra_sql' => "AND bill < ". time. + 'hashref' => {}, + 'extra_sql' => "WHERE plan = 'prepaid' AND bill < ". time. + " AND bill IS NOT NULL". + " AND ( susp IS NULL OR susp = 0)". + " AND ( cancel IS NULL OR cancel = 0)" + } ) + ) { + + my $work_cust_pkg = $cust_pkg; + + my $cust_main = $cust_pkg->cust_main; + if ( $cust_main->total_unapplied_payments > 0 + or $cust_main->total_credited > 0 + ) + { + #this needs a flag to say only do the prepaid packages... + # and only try em if the renewal price matches.. but this will do for now + my $b_error = $cust_main->bill; + if ( $b_error ) { + warn "Error billing customer #". $cust_main->custnum; + next; + } + $b_error = $cust_main->apply_payments_and_credits; + if ( $b_error ) { + warn "Error applying payments&credits, customer #". $cust_main->custnum; + next; + } + + $work_cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $work_cust_pkg->pkgnum } ); + + next + if $cust_main->balance <= 0 + and $work_cust_pkg->bill >= time; + } + + my $action = $work_cust_pkg->part_pkg->option('recur_action') || 'suspend'; + + my $error = $work_cust_pkg->$action(); + + warn "Error ${action}ing package ". $work_cust_pkg->pkgnum. + " for custnum ". $work_cust_pkg->custnum. + ": $error\n" + if $error; + } + + die "exiting" if sigterm() || sigint(); + sleep 5; + +} + +#-- + +sub usage { + die "Usage:\n\n freeside-prepaidd user\n"; +} + +=head1 NAME + +freeside-prepaidd - Real-time daemon for prepaid packages + +=head1 SYNOPSIS + + freeside-prepaidd + +=head1 DESCRIPTION + +Runs continuously and suspends or cancels any prepaid customer packages which +have passed their renewal date (next bill date). + +=head1 SEE ALSO + +=cut + +1; diff --git a/FS/bin/freeside-prune-applications b/FS/bin/freeside-prune-applications new file mode 100755 index 000000000..d2b6efe0b --- /dev/null +++ b/FS/bin/freeside-prune-applications @@ -0,0 +1,63 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($opt_d $opt_q $opt_v); # $opt_n instead of $opt_d? +use vars qw($DEBUG $DRY_RUN); +use Getopt::Std; +use FS::UID qw(adminsuidsetup checkeuid); +use FS::Misc::prune qw(prune_applications); + +die "Not running uid freeside!" unless checkeuid(); + +getopts("dq"); + +$DEBUG = !$opt_q; +#$DEBUG = $opt_v; + +$DRY_RUN = $opt_d; + +my $user = shift or die &usage; +my $dbh = adminsuidsetup($user); + +my $hashref = {}; + +$hashref->{dry_run} = 1 if $DRY_RUN; +$hashref->{debug} = 1 if $DEBUG; + +print join "\n", prune_applications($hashref); +print "\n" if $DRY_RUN; + +$dbh->commit or die $dbh->errstr; + +### + +sub usage { + die "Usage:\n freeside-prune-applications [ -d ] [ -q | -v ] user\n"; +} + +=head1 NAME + +freeside-prune-applications - Removes stray applications of credit, payment to + bills, refunds, etc. + +=head1 SYNOPSIS + + freeside-prune-applications [ -d ] [ -q | -v ] + +=head1 DESCRIPTION + +Reads your existing database schema and updates it to match the current schema, +adding any columns or tables necessary. + + [ -d ]: Dry run; display affected records (to STDOUT) only, but do not + remove them. + + [ -q ]: Run quietly. This may become the default at some point. + + [ -v ]: Run verbosely, sending debugging information to STDERR. This is the + current default. + +=head1 SEE ALSO + +=cut + diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued new file mode 100644 index 000000000..93d735d1a --- /dev/null +++ b/FS/bin/freeside-queued @@ -0,0 +1,250 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw( $DEBUG $kids $max_kids %kids ); +use POSIX qw(:sys_wait_h); +use IO::File; +use FS::UID qw(adminsuidsetup forksuidsetup driver_name dbh myconnect); +use FS::Daemon qw(daemonize1 drop_root logfile daemonize2 sigint sigterm); +use FS::Record qw(qsearch qsearchs); +use FS::queue; +use FS::queue_depend; + +# no autoloading for non-FS classes... +use Net::SSH 0.07; + +$DEBUG = 0; + +$max_kids = '10'; #guess it should be a config file... +$kids = 0; + +my $user = shift or die &usage; + +warn "starting daemonization (forking)\n" if $DEBUG; +#daemonize1('freeside-queued',$user); #to keep pid files unique w/multi installs +daemonize1('freeside-queued'); + +warn "dropping privledges\n" if $DEBUG; +drop_root(); + + +$ENV{HOME} = (getpwuid($>))[7]; #for ssh + +warn "connecting to database\n" if $DEBUG; +$@ = 'not connected'; +while ( $@ ) { + eval { adminsuidsetup $user; }; + if ( $@ ) { + warn $@; + warn "sleeping for reconnect...\n"; + sleep 5; + } +} + +logfile( "%%%FREESIDE_LOG%%%/queuelog.". $FS::UID::datasrc ); + +warn "completing daemonization (detaching))\n" if $DEBUG; +daemonize2(); + +#-- + +my $warnkids=0; +while (1) { + + &reap_kids; + #prevent runaway forking + if ( $kids >= $max_kids ) { + warn "WARNING: maximum $kids children reached\n" unless $warnkids++; + &reap_kids; + sleep 1; #waiting for signals is cheap + next; + } + $warnkids=0; + + unless ( dbh && dbh->ping ) { + warn "WARNING: connection to database lost, reconnecting...\n"; + + eval { $FS::UID::dbh = myconnect; }; + + unless ( !$@ && dbh && dbh->ping ) { + warn "WARNING: still no connection to database, sleeping for retry...\n"; + sleep 10; + next; + } else { + warn "WARNING: reconnected to database\n"; + } + } + + #my($job, $ljob); + #{ + # my $oldAutoCommit = $FS::UID::AutoCommit; + # local $FS::UID::AutoCommit = 0; + $FS::UID::AutoCommit = 0; + + #assuming mysql 4.1 w/subqueries now + #my $nodepend = driver_name eq 'mysql' + # ? '' + # : 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'. + # ' WHERE queue_depend.jobnum = queue.jobnum ) '; + my $nodepend = 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'. + ' WHERE queue_depend.jobnum = queue.jobnum ) '; + + my $job = qsearchs( + 'queue', + { 'status' => 'new' }, + '', + driver_name eq 'mysql' + ? "$nodepend ORDER BY jobnum LIMIT 1 FOR UPDATE" + : "$nodepend ORDER BY jobnum FOR UPDATE LIMIT 1" + ) or do { + # if $oldAutoCommit { + dbh->commit or do { + warn "WARNING: database error, closing connection: ". dbh->errstr; + undef $FS::UID::dbh; + next; + }; + # } + sleep 5; #connecting to db is expensive + next; + }; + + #assuming mysql 4.1 w/subqueries now + #if ( driver_name eq 'mysql' + # && qsearch('queue_depend', { 'jobnum' => $job->jobnum } ) ) { + # dbh->commit or die dbh->errstr; #if $oldAutoCommit; + # sleep 5; #would be better if mysql could do everything in query above + # next; + #} + + my %hash = $job->hash; + $hash{'status'} = 'locked'; + my $ljob = new FS::queue ( \%hash ); + my $error = $ljob->replace($job); + if ( $error ) { + warn "WARNING: database error locking job, closing connection: ". + dbh->errstr; + undef $FS::UID::dbh; + next; + } + + # if $oldAutoCommit { + dbh->commit or do { + warn "WARNING: database error, closing connection: ". dbh->errstr; + undef $FS::UID::dbh; + next; + }; + # } + + $FS::UID::AutoCommit = 1; + #} + + my @args = $ljob->args; + splice @args, 0, 1, $ljob if $args[0] eq '_JOB'; + + defined( my $pid = fork ) or do { + warn "WARNING: can't fork: $!\n"; + my %hash = $job->hash; + $hash{'status'} = 'failed'; + $hash{'statustext'} = "[freeside-queued] can't fork: $!"; + my $ljob = new FS::queue ( \%hash ); + my $error = $ljob->replace($job); + die $error if $error; + next; #don't increment the kid counter + }; + + if ( $pid ) { + $kids++; + $kids{$pid} = 1; + } else { #kid time + + #get new db handle + $FS::UID::dbh->{InactiveDestroy} = 1; + + forksuidsetup($user); + + #auto-use classes... + #if ( $ljob->job =~ /(FS::part_export::\w+)::/ ) { + if ( $ljob->job =~ /(FS::part_export::\w+)::/ + || $ljob->job =~ /(FS::\w+)::/ + ) + { + my $class = $1; + eval "use $class;"; + if ( $@ ) { + warn "job use $class failed"; + my %hash = $ljob->hash; + $hash{'status'} = 'failed'; + $hash{'statustext'} = $@; + my $fjob = new FS::queue( \%hash ); + my $error = $fjob->replace($ljob); + die $error if $error; + exit; #end-of-kid + }; + } + + my $eval = "&". $ljob->job. '(@args);'; + warn 'running "&'. $ljob->job. '('. join(', ', @args). ")\n" if $DEBUG; + eval $eval; #throw away return value? suppose so + if ( $@ ) { + warn "job $eval failed"; + my %hash = $ljob->hash; + $hash{'status'} = 'failed'; + $hash{'statustext'} = $@; + my $fjob = new FS::queue( \%hash ); + my $error = $fjob->replace($ljob); + die $error if $error; + } else { + $ljob->delete; + } + + exit; + #end-of-kid + } + +} continue { + if ( sigterm() ) { + warn "received TERM signal; exiting\n"; + exit; + } + if ( sigint() ) { + warn "received INT signal; exiting\n"; + exit; + } +} + +sub usage { + die "Usage:\n\n freeside-queued user\n"; +} + +sub reap_kids { + foreach my $pid ( keys %kids ) { + my $kid = waitpid($pid, WNOHANG); + if ( $kid > 0 ) { + $kids--; + delete $kids{$kid}; + } + } +} + +=head1 NAME + +freeside-queued - Job queue daemon + +=head1 SYNOPSIS + + freeside-queued user + +=head1 DESCRIPTION + +Job queue daemon. Should be running at all times. + +user: from the mapsecrets file - see config.html from the base documentation + +=head1 VERSION + +=head1 BUGS + +=head1 SEE ALSO + +=cut + diff --git a/FS/bin/freeside-radgroup b/FS/bin/freeside-radgroup new file mode 100644 index 000000000..ed85626d2 --- /dev/null +++ b/FS/bin/freeside-radgroup @@ -0,0 +1,76 @@ +#!/usr/bin/perl -w + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_svc; +use FS::svc_acct; + +&untaint_argv; #what it sounds like (eww) + +my($user, $action, $groupname, $svcpart) = @ARGV; + +adminsuidsetup $user; + +my @svc_acct = map { $_->svc_x } qsearch('cust_svc', { svcpart => $svcpart } ); + +if ( lc($action) eq 'add' ) { + foreach my $svc_acct ( @svc_acct ) { + my @groups = $svc_acct->radius_groups; + next if grep { $_ eq $groupname } @groups; + push @groups, $groupname; + my %hash = $svc_acct->hash; + $hash{usergroup} = \@groups; + my $new = new FS::svc_acct \%hash; + my $error = $new->replace($svc_acct); + die $error if $error; + } +} else { + die &usage; +} + +# subroutines + +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-radgroup user action groupname svcpart\n"; +} + +=head1 NAME + +freeside-radgroup - Command line utility to manipulate radius groups + +=head1 SYNOPSIS + + freeside-addgroup user action groupname svcpart + +=head1 DESCRIPTION + + B<user> is a freeside user as added with freeside-adduser. + + B<command> is the action to take. Available actions are: I<add> + + B<groupname> is the group to add (or remove, etc.) + + B<svcpart> specifies which accounts will be updated. + +=head1 EXAMPLES + +freeside-radgroup freesideuser add groupname 3 + +Adds I<groupname> to all accounts with service definition 3. + +=head1 BUGS + +=head1 SEE ALSO + +L<freeside-adduser>, L<FS::svc_acct>, L<FS::part_svc> + +=cut + diff --git a/FS/bin/freeside-reexport b/FS/bin/freeside-reexport new file mode 100644 index 000000000..54af9dd80 --- /dev/null +++ b/FS/bin/freeside-reexport @@ -0,0 +1,71 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($opt_s $opt_u $opt_p); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::part_export; +use FS::svc_acct; +use FS::cust_svc; + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $export_x = shift or die &usage; +my @part_export; +if ( $export_x =~ /^(\d+)$/ ) { + @part_export = qsearchs('part_export', { exportnum=>$1 } ) + or die "exportnum $export_x not found\n"; +} else { + @part_export = qsearch('part_export', { exporttype=>$export_x } ) + or die "no exports of type $export_x found\n"; +} + +getopts('s:u:p:'); + +my @svc_x = (); +if ( $opt_s ) { + my $cust_svc = qsearchs('cust_svc', { svcnum=>$opt_s } ) + or die "svcnum $opt_s not found\n"; + push @svc_x, $cust_svc->svc_x; +} elsif ( $opt_u ) { + my $svc_x = qsearchs('svc_acct', { username=>$opt_u } ) + or die "username $opt_u not found\n"; + push @svc_x, $svc_x; +} elsif ( $opt_p ) { + push @svc_x, map { $_->svc_x } qsearch('cust_svc', { svcpart=>$opt_p } ); + die "no services with svcpart $opt_p found\n" unless @svc_x; +} + +foreach my $part_export ( @part_export ) { + foreach my $svc_x ( @svc_x ) { + my $error = $part_export->export_insert($svc_x); + die $error if $error; + } +} + + +sub usage { + die "Usage:\n\n freeside-reexport user exportnum|exporttype [ -s svcnum | -u username | -p svcpart ]\n"; +} + +=head1 NAME + +freeside-reexport - Command line tool to re-trigger export jobs for existing services + +=head1 SYNOPSIS + + freeside-reexport user exportnum|exporttype [ -s svcnum | -u username | -p svcpart ] + +=head1 DESCRIPTION + + Re-queues the export job for the specified exportnum or exporttype(s) and + specified service (selected by svcnum or username). + +=head1 SEE ALSO + +L<freeside-sqlradius-reset>, L<FS::part_export> + +=cut + diff --git a/FS/bin/freeside-reset-fixed b/FS/bin/freeside-reset-fixed new file mode 100755 index 000000000..5829d441b --- /dev/null +++ b/FS/bin/freeside-reset-fixed @@ -0,0 +1,69 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($opt_p $opt_s $opt_r); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::cust_svc; +use FS::svc_Common; + +getopts('p:s:r'); + +my $user = shift or die &usage; +adminsuidsetup $user; + +die &usage + if ($opt_p && $opt_s); + +$FS::Record::nowarn_identical = 1; +$FS::svc_Common::noexport_hack = 1 + unless $opt_r; + +my @svc_x = (); +if ( $opt_s ) { + $opt_s =~ /^(\d+)$/ or die "invalid svcnum"; + my $cust_svc = qsearchs('cust_svc', { svcnum => $1 } ) + or die "svcnum $opt_s not found\n"; + push @svc_x, $cust_svc->svc_x; +} elsif ( $opt_p ) { + $opt_p =~ /^(\d+)$/ or die "invalid svcpart"; + push @svc_x, map { $_->svc_x } qsearch('cust_svc', { svcpart => $1 } ); + die "no services with svcpart $opt_p found\n" unless @svc_x; +} else { + push @svc_x, map { $_->svc_x } qsearch('cust_svc', {} ); + die "no services found\n" unless @svc_x; +} + +foreach my $svc_x ( @svc_x ) { + my $result = $svc_x->setfixed; + die $result unless ref($result); + my $error = $svc_x->replace + if $svc_x->modified; + die $error if $error; +} + + +sub usage { + die "Usage:\n\n freeside-reset-fixed user [ -s svcnum | -p svcpart ] [ -r ]\n"; +} + +=head1 NAME + +freeside-reset-fixed - Command line tool to set the fixed columns for existing services + +=head1 SYNOPSIS + + freeside-reset-fixed user [ -s svcnum | -p svcpart ] [ -r ] + +=head1 DESCRIPTION + + Resets the fixed columns for the specified service part or service number. + Re-exports the service if -r is specified. + +=head1 SEE ALSO + +L<freeside-reexport>, L<FS::part_svc> + +=cut + diff --git a/FS/bin/freeside-selfservice-server b/FS/bin/freeside-selfservice-server new file mode 100644 index 000000000..2087e7130 --- /dev/null +++ b/FS/bin/freeside-selfservice-server @@ -0,0 +1,240 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw( $FREESIDE_LOG $FREESIDE_LOCK ); +use vars qw( $Debug %kids $kids $max_kids $ssh_pid %old_ssh_pid $keepalives ); +use subs qw( lock_write unlock_write myshutdown usage ); +use Fcntl qw(:flock); +use POSIX qw(:sys_wait_h); +use IO::Handle; +use IO::Select; +use IO::File; +use Storable 2.09 qw(nstore_fd fd_retrieve); +use Net::SSH qw(sshopen2); +use FS::Daemon qw(daemonize1 drop_root logfile daemonize2 sigint sigterm); +use FS::UID qw(adminsuidsetup forksuidsetup); +use FS::ClientAPI; +use FS::ClientAPI_SessionCache; + +use FS::Conf; +use FS::cust_svc; + +$FREESIDE_LOG = "%%%FREESIDE_LOG%%%"; +$FREESIDE_LOCK = "%%%FREESIDE_LOCK%%%"; + +$Debug = 1; # 2 will turn on more logging + # 3 will log packet contents, including passwords + +$max_kids = '10'; #? +$keepalives = 0; #let clientd turn it on, so we don't barf on old ones +$kids = 0; + +my $user = shift or die &usage; +my $machine = shift or die &usage; +my $tag = scalar(@ARGV) ? shift : ''; + +my $lock_file = "$FREESIDE_LOCK/selfservice.$machine.writelock"; + +# to keep pid files unique w/multi machines (and installs!) +# $FS::UID::datasrc not posible +daemonize1("freeside-selfservice-server","$user.$machine"); + +#false laziness w/Daemon::drop_root +my $freeside_gid = scalar(getgrnam('freeside')) + or die "can't find freeside group\n"; + +open(LOCKFILE,">$lock_file") or die "can't open $lock_file: $!"; +chown $FS::UID::freeside_uid, $freeside_gid, $lock_file; + +drop_root(); + +$ENV{HOME} = (getpwuid($>))[7]; #for ssh + +adminsuidsetup $user; + +#logfile("/usr/local/etc/freeside/selfservice.". $FS::UID::datasrc); #MACHINE +logfile("$FREESIDE_LOG/selfservice.$machine.log"); + +daemonize2(); + +my $conf = new FS::Conf; +if ( $conf->exists('selfservice-ignore_quantity') ) { + $FS::cust_svc::ignore_quantity = 1; + $FS::cust_svc::ignore_quantity = 1; #now it is used twice. +} + +#clear the signup info cache so an "/etc/init.d/freeside restart" will pick +#up new info... (better as a callback in Signup.pm?) +my $cache = new FS::ClientAPI_SessionCache( { + 'namespace' => 'FS::ClientAPI::Signup', +} ); +$cache->remove('signup_info_cache'); + +my $clientd = "/usr/local/sbin/freeside-selfservice-clientd"; #better name? + +my $warnkids=0; +while (1) { + my($writer,$reader,$error) = (new IO::Handle, new IO::Handle, new IO::Handle); + warn "connecting to $machine\n" if $Debug; + + $ssh_pid = sshopen2($machine,$reader,$writer,$clientd,$tag); + +# nstore_fd(\*writer, {'hi'=>'there'}); + + warn "entering main loop\n" if $Debug; + my $undisp = 0; + my $keepalive_count = 0; + my $s = IO::Select->new( $reader ); + while (1) { + + &reap_kids; + + warn "waiting for packet from client\n" if $Debug && !$undisp; + $undisp = 1; + my @handles = $s->can_read(5); + unless ( @handles ) { + myshutdown() if sigint() || sigterm(); + if ( $keepalives && $keepalive_count++ > 10 ) { + $keepalive_count = 0; + lock_write; + nstore_fd( { _token => '_keepalive' }, $writer ); + unlock_write; + } + next; + } + + $undisp = 0; + + warn "receiving packet from client\n" if $Debug; + + my $packet = eval { fd_retrieve($reader); }; + if ( $@ ) { + warn "Storable error receiving packet from client". + " (assuming lost connection): $@\n" + if $Debug; + if ( $ssh_pid ) { + warn "sending TERM signal to ssh process $ssh_pid\n" if $Debug; + kill 'TERM', $ssh_pid; + $old_ssh_pid{$ssh_pid} = 1; + $ssh_pid = 0; + } + last; + } + warn "packet received\n". + join('', map { " $_=>$packet->{$_}\n" } keys %$packet ) + if $Debug > 2; + + if ( $packet->{_packet} eq '_enable_keepalive' ) { + warn "enabling keep alives\n" if $Debug; + $keepalives=1; + next; + } + + #prevent runaway forking + my $warnkids = 0; + while ( $kids >= $max_kids ) { + warn "WARNING: maximum $kids children reached\n" unless $warnkids++; + &reap_kids; + sleep 1; + } + + warn "forking child\n" if $Debug; + defined( my $pid = fork ) or die "can't fork: $!"; + if ( $pid ) { + $kids++; + $kids{$pid} = 1; + warn "child $pid spawned\n" if $Debug; + } else { #kid time + + ##get new db handle + $FS::UID::dbh->{InactiveDestroy} = 1; + forksuidsetup($user); + + #get db handle + #adminsuidsetup($user); + + my $type = $packet->{_packet}; + warn "calling $type handler\n" if $Debug; + my $rv = eval { FS::ClientAPI->dispatch($type, $packet); }; + if ( $@ ) { + warn my $error = "WARNING: error dispatching $type: $@"; + $rv = { _error => $error }; + } + $rv->{_token} = $packet->{_token}; #identifier + + open(LOCKFILE,">$lock_file") or die "can't open $lock_file: $!"; + lock_write; + warn "sending response\n" if $Debug; + nstore_fd($rv, $writer) or die "FATAL: can't send response: $!"; + $writer->flush or die "FATAL: can't flush: $!"; + unlock_write; + + warn "child exiting\n" if $Debug; + exit; #end-of-kid + } + + } + + myshutdown if sigint() || sigterm(); + warn "connection lost, reconnecting\n" if $Debug; + sleep 3; + +} + +### +# utility subroutines +### + +sub reap_kids { + #warn "reaping kids\n"; + foreach my $pid ( keys %kids ) { + my $kid = waitpid($pid, WNOHANG); + if ( $kid > 0 ) { + $kids--; + delete $kids{$kid}; + } + } + + foreach my $pid ( keys %old_ssh_pid ) { + waitpid($pid, WNOHANG) and delete $old_ssh_pid{$pid}; + } + #warn "done reaping\n"; +} + +sub myshutdown { + &reap_kids; + my $wait = 12; #wait up to 1 minute + while ( $kids > 0 && $wait-- ) { + warn "waiting for $kids children to terminate"; + sleep 5; + &reap_kids; + } + warn "abandoning $kids children" if $kids; + kill 'TERM', $ssh_pid if $ssh_pid; + die "exiting"; +} + +sub lock_write { + warn "locking $lock_file mutex for write to write stream\n" if $Debug > 1; + + #broken on freebsd? + #flock($writer, LOCK_EX) or die "FATAL: can't lock write stream: $!"; + + flock(LOCKFILE, LOCK_EX) or die "FATAL: can't lock $lock_file: $!"; + +} + +sub unlock_write { + warn "unlocking $lock_file mutex\n" if $Debug > 1; + + #broken on freebsd? + #flock($writer, LOCK_UN) or die "WARNING: can't release write lock: $!"; + + flock(LOCKFILE, LOCK_UN) or die "FATAL: can't unlock $lock_file: $!"; + +} + +sub usage { + die "Usage:\n\n freeside-selfservice-server user machine\n"; +} + diff --git a/FS/bin/freeside-setinvoice b/FS/bin/freeside-setinvoice new file mode 100644 index 000000000..708e2fa30 --- /dev/null +++ b/FS/bin/freeside-setinvoice @@ -0,0 +1,42 @@ +#!/usr/bin/perl + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Conf; +use FS::Record qw(qsearch qsearchs); +use FS::cust_main; +use FS::svc_acct; + +&untaint_argv; #what it sounds like (eww) +my $user = shift or die &usage; + +adminsuidsetup $user; + +foreach my $cust_main ( + grep { ! scalar($_->invoicing_list) } + qsearch( 'cust_main', {} ) +) { + my @dest; + my @cust_pkg = $cust_main->ncancelled_pkgs; + foreach my $cust_pkg ( @cust_pkg ) { + foreach my $cust_svc ( $cust_pkg->cust_svc ) { + my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $cust_svc->svcnum } ); + push @dest, $svc_acct->svcnum if $svc_acct; + } + } + push @dest, 'POST' unless @dest; + $cust_main->invoicing_list(\@dest); +} + +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-setinvoice user\n"; +} + + diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup new file mode 100755 index 000000000..9b16d78cb --- /dev/null +++ b/FS/bin/freeside-setup @@ -0,0 +1,160 @@ +#!/usr/bin/perl -Tw + +#to delay loading dbdef until we're ready +BEGIN { $FS::Schema::setup_hack = 1; } + +use strict; +use vars qw($opt_u $opt_d $opt_v); +use Getopt::Std; +use FS::UID qw(adminsuidsetup datasrc checkeuid getsecrets); +use FS::CurrentUser; +use FS::Schema qw( dbdef_dist reload_dbdef ); +use FS::Record qw( qsearch ); +#use FS::raddb; +use FS::Setup qw(create_initial_data); +use FS::Conf; + +die "Not running uid freeside!" unless checkeuid(); + +#my %attrib2db = +# map { lc($FS::raddb::attrib{$_}) => $_ } keys %FS::raddb::attrib; + +getopts("u:vd:"); +my $config_dir = shift || 'conf' ; +$config_dir =~ /^([\w.:=]+)$/ + or die "unacceptable configuration directory name"; +$config_dir = $1; + +getsecrets($opt_u); + +#needs to match FS::Record +my($dbdef_file) = "%%%FREESIDE_CONF%%%/dbdef.". datasrc; + +### + +my $username_len = 32; + +#print "\n\n", <<END, ":"; +#Freeside tracks the RADIUS User-Name, check attribute Password and +#reply attribute Framed-IP-Address for each user. You can specify additional +#check and reply attributes (or you can add them later with the +#fs-radius-add-check and fs-radius-add-reply programs). +# +#First enter any additional RADIUS check attributes you need to track for each +#user, separated by whitespace. +#END +#my @check_attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; } +# split(" ",&getvalue); +# +#print "\n\n", <<END, ":"; +#Now enter any additional reply attributes you need to track for each user, +#separated by whitespace. +#END +#my @attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; } +# split(" ",&getvalue); +# +#print "\n\n", <<END, ":"; +#Do you wish to enable the tracking of a second, separate shipping/service +#address? +#END +#my $ship = &_yesno; +# +#sub getvalue { +# my($x)=scalar(<STDIN>); +# chop $x; +# $x; +#} +# +#sub _yesno { +# print " [y/N]:"; +# my $x = scalar(<STDIN>); +# $x =~ /^y/i; +#} + +#my @check_attributes = (); #add later +#my @attributes = (); #add later +#my $ship = $opt_s; + +### +# create a dbdef object from the old data structure +### + +my $dbdef = dbdef_dist(datasrc); + +#important +$dbdef->save($dbdef_file); +&FS::Schema::reload_dbdef($dbdef_file); + +### +# create 'em +### + +$FS::CurrentUser::upgrade_hack = 1; +$FS::UID::callback_hack = 1; +my $dbh = adminsuidsetup $opt_u; #$user; +$FS::UID::callback_hack = 0; + +#create tables +$|=1; + +foreach my $statement ( $dbdef->sql($dbh) ) { + $dbh->do( $statement ) + or die "CREATE error: ". $dbh->errstr. "\ndoing statement: $statement"; +} + +#now go back and reverse engineer the db +#so we pick up the correct column DEFAULTs for #oidless inserts +dbdef_create($dbh, $dbdef_file); +delete $FS::Schema::dbdef_cache{$dbdef_file}; #force an actual reload +reload_dbdef($dbdef_file); + +warn "Freeside schema initialized - commiting transaction\n" if $opt_v; + +$dbh->commit or die $dbh->errstr; +$dbh->disconnect or die $dbh->errstr; + +warn "Database schema committed successfully\n" if $opt_v; + +warn "Initializing freeside configuration\n" if $opt_v; +$FS::UID::callback_hack = 1; +$dbh = adminsuidsetup $opt_u; +$FS::UID::callback_hack = 0; +if (!scalar(qsearch('conf', {}))) { + my $error = FS::Conf::init_config($config_dir); + if ($error) { + $dbh->rollback or die $dbh->errstr; + die $error; + } +} + +warn "Freeside configuration initialized - commiting transaction\n" if $opt_v; + +$dbh->commit or die $dbh->errstr; +$dbh->disconnect or die $dbh->errstr; + +warn "Freeside configuration committed successfully\n" if $opt_v; + +$dbh = adminsuidsetup $opt_u; +create_initial_data('domain' => $opt_d); + +warn "Freeside database initialized - commiting transaction\n" if $opt_v; + +$dbh->commit or die $dbh->errstr; +$dbh->disconnect or die $dbh->errstr; + +warn "Database initialization committed successfully\n" if $opt_v; + +sub dbdef_create { # reverse engineer the schema from the DB and save to file + my( $dbh, $file ) = @_; + my $dbdef = new_native DBIx::DBSchema $dbh; + $dbdef->save($file); +} + +sub usage { + die "Usage:\n freeside-setup -d domain.name [ -v ] [ config/dir ]\n" + # [ -u user ] for devel/multi-db installs +} + +1; + + diff --git a/FS/bin/freeside-sqlradius-dedup-group b/FS/bin/freeside-sqlradius-dedup-group new file mode 100755 index 000000000..441d50f62 --- /dev/null +++ b/FS/bin/freeside-sqlradius-dedup-group @@ -0,0 +1,82 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw( %seen @dups ); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::part_export; + +my %allowed_types = map { $_ => 1 } qw ( sqlradius sqlradius_withdomain ); + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $export_x = shift; +my @part_export; +if ( !defined($export_x) ) { + @part_export = qsearch('part_export', {} ); +} elsif ( $export_x =~ /^(\d+)$/ ) { + @part_export = qsearchs('part_export', { exportnum=>$1 } ) + or die "exportnum $export_x not found\n"; +} else { + @part_export = qsearch('part_export', { exporttype=>$export_x } ) + or die "no exports of type $export_x found\n"; +} + +@part_export = grep { $allowed_types{$_->exporttype} } @part_export + or die "No sqlradius exports specified."; + +foreach my $part_export ( @part_export ) { + my $dbh = DBI->connect( map $part_export->option($_), + qw ( datasrc username password ) ); + + my $sth = $dbh->prepare("SELECT id,username,groupname + FROM usergroup ORDER By username,groupname,id") + or die $dbh->errstr; + $sth->execute() or die $sth->errstr; + + @dups = (); %seen = (); + while (my $row = $sth->fetchrow_arrayref ) { + my ($userid, $username, $groupname) = @$row; + unless ( exists($seen{$username}{$groupname}) ) { + $seen{$username}{$groupname} = $userid; + next; + } + push @dups, $userid; + } + + $sth = $dbh->prepare("DELETE FROM usergroup WHERE id = ?") + or die $dbh->errstr; + + foreach (@dups) { + $sth->execute($_) or die $sth->errstr; + } + +} + + +sub usage { + die "Usage:\n\n freeside-sqlradius-dedup-group user [ exportnum|exporttype ]\n"; +} + +=head1 NAME + +freeside-sqlradius-dedup-group - Command line tool to eliminate duplicate usergroup entries from radius tables + +=head1 SYNOPSIS + + freeside-sqlradius-dedup-group user [ exportnum|exporttype ] + +=head1 DESCRIPTION + + Removes all but one username groupname pair when duplicate entries exist + for the specified export (selected by exportnum or exporttype) or all + exports if none are specified. + +=head1 SEE ALSO + +L<freeside-reexport>, L<freeside-sqlradius-reset>, L<FS::part_export> + +=cut + diff --git a/FS/bin/freeside-sqlradius-radacctd b/FS/bin/freeside-sqlradius-radacctd new file mode 100644 index 000000000..83fd4bfd1 --- /dev/null +++ b/FS/bin/freeside-sqlradius-radacctd @@ -0,0 +1,150 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw( @part_export ); +use subs qw(myshutdown); +use POSIX qw(:sys_wait_h); +#use IO::File; +use FS::Daemon qw(daemonize1 drop_root logfile daemonize2 sigint sigterm); +use FS::UID qw(adminsuidsetup); #forksuidsetup driver_name dbh myconnect); +use FS::Record qw(qsearch); # qsearchs); +use FS::part_export; +#use FS::svc_acct; +#use FS::cust_svc; + +my $user = shift or die &usage; + +#daemonize1('freeside-sqlradius-radacctd', $user); #keep unique pid files w/multi installs +daemonize1('freeside-sqlradius-radacctd'); + +drop_root(); + +#$ENV{HOME} = (getpwuid($>))[7]; #for ssh + +adminsuidsetup $user; + +logfile( "%%%FREESIDE_LOG%%%/sqlradius-radacctd-log.". $FS::UID::datasrc ); + +daemonize2(); + +#-- + +#don't just look for ->can('usage_sessions'), we're sqlradius-specific +# (radiator is supposed to be setup with a radacct table) + +@part_export = + qsearch('part_export', { 'exporttype' => 'sqlradius' } ); +push @part_export, + qsearch('part_export', { 'exporttype' => 'sqlradius_withdomain' } ); +push @part_export, + qsearch('part_export', { 'exporttype' => 'radiator' } ); + +@part_export = grep { ! $_->option('ignore_accounting') } @part_export; + +die "no sqlradius, sqlradius_withdomain or radiator exports without". + " ignore_accounting" + unless @part_export; + +while (1) { + + #fork off one kid per export (machine) + # _>{'_radacct_kid'} is an evil kludge + foreach my $part_export ( grep ! $_->{'_radacct_kid'}, @part_export ) { + + defined( my $pid = fork ) or do { + warn "WARNING: can't fork to spawn child for ". $part_export->machine; + next; + }; + + if ( $pid ) { + $part_export->{'_radacct_kid'} = $pid; + warn "child $pid spawned for ". $part_export->machine; + } else { #kid time + + adminsuidsetup($user); #get our own db handle + + until ( sigint || sigterm ) { + $part_export->update_svc_acct(); + sleep 1; + } + + warn "child for ". $part_export->machine. " done"; + exit; + + } #eo kid + + } + + #reap up any kids that died... + &reap_kids; + + myshutdown() if sigterm() || sigint(); + + sleep 5; +} + +#-- + +sub myshutdown { + &reap_kids; + + #kill all the kids + kill 'TERM', $_ foreach grep $_, map $_->{'_radacct_kid'}, @part_export; + + my $wait = 12; #wait up to 1 minute + while ( ( grep $_->{'_radacct_kid'}, @part_export ) && $wait-- ) { + warn "waiting for children to terminate"; + sleep 5; + &reap_kids; + } + warn "abandoning children" if grep $_->{'_radacct_kid'}, @part_export; + die "exiting"; +} + +sub reap_kids { + #warn "reaping kids\n"; + foreach my $part_export ( grep $_->{'_radacct_kid'}, @part_export ) { + my $pid = $part_export->{'_radacct_kid'}; + my $kid = waitpid($pid, WNOHANG); + if ( $kid > 0 ) { + $part_export->{'_radacct_kid'} = ''; + } + } + #warn "done reaping\n"; +} + +sub usage { + die "Usage:\n\n freeside-sqlradius-radacctd user\n"; +} + +=head1 NAME + +freeside-sqlradius-radacctd - Real-time radacct import daemon + +=head1 SYNOPSIS + + freeside-sqlradius-radacctd username + +=head1 DESCRIPTION + +Imports records from an the SQL radacct tables of all sqlradius, +sqlradius_withdomain and radiator exports (except those with the +ignore_accounting flag) and updates the svc_acct.seconds for each account. +Runs as a daemon and updates the database in real-time. + +B<username> is a username added by freeside-adduser. + +=head1 RADIUS DATABASE CHANGES + +ALTER TABLE radacct ADD COLUMN FreesideStatus varchar(32) NULL; + +If you want to ignore the existing accountg records, also do: + +UPDATE radacct SET FreesideStatus = 'done' WHERE FreesideStatus IS NULL; + +=head1 SEE ALSO + +=cut + +1; + diff --git a/FS/bin/freeside-sqlradius-reset b/FS/bin/freeside-sqlradius-reset new file mode 100755 index 000000000..94fa68a06 --- /dev/null +++ b/FS/bin/freeside-sqlradius-reset @@ -0,0 +1,104 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw( $opt_n ); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::part_export; +use FS::svc_acct; +use FS::cust_svc; + +getopts("n"); + +my $user = shift or die &usage; +adminsuidsetup $user; + +#my $machine = shift or die &usage; + +my @exports = (); +if ( @ARGV ) { + foreach my $exportnum ( @ARGV ) { + foreach my $exporttype (qw( sqlradius sqlradius_withdomain )) { + push @exports, qsearch('part_export', { exportnum => $exportnum, + exporttype => $exporttype, } ); + } + } + } else { + @exports = qsearch('part_export', { exporttype=>'sqlradius' } ); + push @exports, qsearch('part_export', { exporttype=>'sqlradius_withdomain' } ); +} + +unless ( $opt_n ) { + foreach my $export ( @exports ) { + my $icradius_dbh = DBI->connect( + map { $export->option($_) } qw( datasrc username password ) + ) or die $DBI::errstr; + for my $table (qw( radcheck radreply usergroup )) { + my $sth = $icradius_dbh->prepare("DELETE FROM $table"); + $sth->execute or die "Can't reset $table table: ". $sth->errstr; + } + $icradius_dbh->disconnect; + } +} + +foreach my $export ( @exports ) { + + #my @svcparts = map { $_->svcpart } $export->export_svc; + my $overlimit_groups = $export->option('overlimit_groups'); + + my @svc_acct = + map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) } + map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } + grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } + $export->export_svc; + + foreach my $svc_acct ( @svc_acct ) { + + $svc_acct->check; #set any fixed usergroup so it'll export even if all + #svc_acct records don't have the group yet + + if ($overlimit_groups && $svc_acct->overlimit) { + $svc_acct->usergroup( &{ $svc_acct->_fieldhandlers->{'usergroup'} } + ($svc_acct, $overlimit_groups) + ); + } + + #false laziness with FS::svc_acct::insert (like it matters) + my $error = $export->export_insert($svc_acct); + die $error if $error; + + } +} + +sub usage { + die "Usage:\n\n freeside-sqlradius-reset user [ exportnum, ... ]\n"; +} + +=head1 NAME + +freeside-sqlradius-reset - Command line interface to reset and recreate RADIUS SQL tables + +=head1 SYNOPSIS + + freeside-sqlradius-reset [ -n ] username [ EXPORTNUM, ... ] + +=head1 DESCRIPTION + +Deletes the radcheck, radreply and usergroup tables and repopulates them from +the Freeside database, for the specified exports, or, if no exports are +specified, for all sqlradius and sqlradius_withdomain exports. + +B<username> is a username added by freeside-adduser. + +The B<-n> option, if supplied, supresses the deletion of the existing data in +the tables. + +=head1 SEE ALSO + +L<freeside-reexport>, L<FS::part_export>, L<FS::part_export::sqlradius> + +=cut + + + diff --git a/FS/bin/freeside-sqlradius-seconds b/FS/bin/freeside-sqlradius-seconds new file mode 100644 index 000000000..9999cbbf3 --- /dev/null +++ b/FS/bin/freeside-sqlradius-seconds @@ -0,0 +1,58 @@ +#!/usr/bin/perl -Tw + +use strict; +use Date::Parse; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearchs); +use FS::svc_acct; + +my $fs_user = shift or die &usage; +adminsuidsetup( $fs_user ); + +my $target_user = shift or die &usage; +my $start = shift or die &usage; +$start = str2time($start); +my $stop = scalar(@ARGV) ? str2time(shift) : time; + +my $svc_acct = qsearchs( 'svc_acct', { 'username' => $target_user } ); +die "username $target_user not found\n" unless $svc_acct; + +print $svc_acct->seconds_since_sqlradacct( $start, $stop ). "\n"; + +sub usage { + die "Usage:\n\n freeside-sqlradius-seconds freeside_username target_username start_date stop_date\n"; +} + + +=head1 NAME + +freeside-sqlradius-seconds - Command line time-online tool + +=head1 SYNOPSIS + + freeside-sqlradius-seconds freeside_username target_username start_date [ stop_date ] + +=head1 DESCRIPTION + +Returns the number of seconds the specified username has been online between +start_date (inclusive) and stop_date (exclusive). +See L<FS::svc_acct/seconds_since_sqlradacct> + +B<freeside_username> is a username added by freeside-adduser. +B<target_username> is the username of the user account to query. +B<start_date> and B<stop_date> are in any format Date::Parse is happy with. +B<stop_date> defaults to now if not specified. + +=head1 BUGS + +Selection of the account in question is rather simplistic in that +B<target_username> doesn't necessarily identify a unique account (and wouldn't +even if a domain was specified), and no sqlradius export is checked for. + +=head1 SEE ALSO + +L<FS::svc_acct/seconds_since_sqlradacct> + +=cut + +1; diff --git a/FS/bin/freeside-sqlradius-set-lastlog b/FS/bin/freeside-sqlradius-set-lastlog new file mode 100755 index 000000000..ad8563076 --- /dev/null +++ b/FS/bin/freeside-sqlradius-set-lastlog @@ -0,0 +1,102 @@ +#!/usr/bin/perl -w + +use strict; +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs str2time_sql); +use FS::Conf; +use FS::part_export; +use FS::svc_acct; + +my %allowed_types = map { $_ => 1 } qw ( sqlradius sqlradius_withdomain ); +my $conf = new FS::Conf; + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $export_x = shift; +my @part_export; +if ( !defined($export_x) ) { + @part_export = qsearch('part_export', {} ); +} elsif ( $export_x =~ /^(\d+)$/ ) { + @part_export = qsearchs('part_export', { exportnum=>$1 } ) + or die "exportnum $export_x not found\n"; +} else { + @part_export = qsearch('part_export', { exporttype=>$export_x } ) + or die "no exports of type $export_x found\n"; +} + +# gross almost false laziness with FS::part_export::sqlradius::update_svc_acct +@part_export = grep { ! $_->option('ignore_accounting') } + grep { $allowed_types{$_->exporttype} } + @part_export + or die "No sqlradius exports specified."; + + +foreach my $part_export ( @part_export ) { + my $dbh = DBI->connect( map $part_export->option($_), + qw ( datasrc username password ) ); + + my $str2time = str2time_sql( $dbh->{Driver}->{Name} ); + my $group = "UserName"; + $group .= ",Realm" + if ( ref($part_export) =~ /withdomain/ ); + + my $sth = $dbh->prepare("SELECT UserName, Realm, + $str2time max(AcctStartTime)), + $str2time max(AcctStopTime)) + FROM radacct + WHERE AcctStartTime != 0 AND AcctStopTime != 0 + GROUP BY $group") + or die $dbh->errstr; + $sth->execute() or die $sth->errstr; + + while (my $row = $sth->fetchrow_arrayref ) { + my ($username, $realm, $start, $stop) = @$row; + + $username = lc($username) unless $conf->exists('username-uppercase'); + my $extra_sql = ''; + 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( 'svc_acct', + { 'username' => $username }, + '', + $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); + } + } +} + + +sub usage { + die "Usage:\n\n freeside-sqlradius-set_lastlog user [ exportnum|exporttype ]\n"; +} + +=head1 NAME + +freeside-sqlradius-set-lastlog - Command line tool to set last_login and last_logout values from radius tables + +=head1 SYNOPSIS + + freeside-sqlradius-set-lastlog user [ exportnum|exporttype ] + +=head1 DESCRIPTION + + Sets the last_login and last_logout columns of each svc_acct based on + data in the radacct table for the specified export (selected by exportnum + or exporttype) or all exports if none are specified. + +=head1 SEE ALSO + +L<freeside-sqlradius-radacctd>, L<FS::part_export> + +=cut + diff --git a/FS/bin/freeside-upgrade b/FS/bin/freeside-upgrade new file mode 100755 index 000000000..d143d9206 --- /dev/null +++ b/FS/bin/freeside-upgrade @@ -0,0 +1,175 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($opt_d $opt_q $opt_v); +use vars qw($DEBUG $DRY_RUN); +use Getopt::Std; +use DBIx::DBSchema 0.31; +use FS::UID qw(adminsuidsetup checkeuid datasrc ); #getsecrets); +use FS::CurrentUser; +use FS::Schema qw( dbdef dbdef_dist reload_dbdef ); +use FS::Misc::prune qw(prune_applications); +use FS::Conf; +use FS::Record qw(qsearch); +use FS::Upgrade qw(upgrade); + +die "Not running uid freeside!" unless checkeuid(); + +getopts("dq"); + +$DEBUG = !$opt_q; +#$DEBUG = $opt_v; + +$DRY_RUN = $opt_d; + +my $user = shift or die &usage; +$FS::CurrentUser::upgrade_hack = 1; +$FS::UID::callback_hack = 1; +my $dbh = adminsuidsetup($user); +$FS::UID::callback_hack = 0; + +#needs to match FS::Schema... +my $dbdef_file = "%%%FREESIDE_CONF%%%/dbdef.". datasrc; + +dbdef_create($dbh, $dbdef_file); + +delete $FS::Schema::dbdef_cache{$dbdef_file}; #force an actual reload +reload_dbdef($dbdef_file); + +$DBIx::DBSchema::DEBUG = $DEBUG; +$DBIx::DBSchema::Table::DEBUG = $DEBUG; +$DBIx::DBSchema::Index::DEBUG = $DEBUG; + +my @bugfix = (); + +if (dbdef->table('cust_main')->column('agent_custid')) { + push @bugfix, + "UPDATE cust_main SET agent_custid = NULL where agent_custid = ''"; + + push @bugfix, + "UPDATE h_cust_main SET agent_custid = NULL where agent_custid = ''" + if (dbdef->table('h_cust_main')); +} + +#you should have run fs-migrate-part_svc ages ago, when you upgraded +#from 1.3 to 1.4... if not, it needs to be hooked into -upgrade here or +#you'll lose all the part_svc settings it migrates to part_svc_column + +if ( $DRY_RUN ) { + print + join(";\n", @bugfix, dbdef->sql_update_schema( dbdef_dist(datasrc), $dbh ) ). ";\n"; + exit; +} else { + foreach my $statement ( @bugfix ) { + $dbh->do( $statement ) + or die "Error: ". $dbh->errstr. "\n executing: $statement"; + } + + dbdef->update_schema( dbdef_dist(datasrc), $dbh ); +} + +my $hashref = {}; +$hashref->{dry_run} = 1 if $DRY_RUN; +$hashref->{debug} = 1 if $DEBUG; +print join "\n", prune_applications($hashref); +print "\n" if $DRY_RUN; + +if ( $dbh->{Driver}->{Name} =~ /^mysql/i ) { + + my $sth = $dbh->prepare( + "SELECT COUNT(*) FROM duplicate_lock WHERE lockname = 'svc_acct'" + ) or die $dbh->errstr; + + $sth->execute or die $sth->errstr; + + unless ( $sth->fetchrow_arrayref->[0] ) { + + $sth = $dbh->prepare( + "INSERT INTO duplicate_lock ( lockname ) VALUES ( 'svc_acct' )" + ) or die $dbh->errstr; + + $sth->execute or die $sth->errstr; + + } +} + +$dbh->commit or die $dbh->errstr; + +dbdef_create($dbh, $dbdef_file); + +$dbh->disconnect or die $dbh->errstr; + +delete $FS::Schema::dbdef_cache{$dbdef_file}; #force an actual reload +$FS::UID::AutoCommit = 0; +$FS::UID::callback_hack = 1; +$dbh = adminsuidsetup($user); +$FS::UID::callback_hack = 0; +unless ( $DRY_RUN ) { + my $dir = "%%%FREESIDE_CONF%%%/conf.". datasrc; + if (!scalar(qsearch('conf', {}))) { + my $error = FS::Conf::init_config($dir); + if ($error) { + warn "CONFIGURATION UPGRADE FAILED\n"; + $dbh->rollback or die $dbh->errstr; + die $error; + } + } +} +$dbh->commit or die $dbh->errstr; +$dbh->disconnect or die $dbh->errstr; + +$dbh = adminsuidsetup($user); + +upgrade() + unless $DRY_RUN; + +$dbh->commit or die $dbh->errstr; +$dbh->disconnect or die $dbh->errstr; + +### + +sub dbdef_create { # reverse engineer the schema from the DB and save to file + my( $dbh, $file ) = @_; + my $dbdef = new_native DBIx::DBSchema $dbh; + $dbdef->save($file); +} + +sub usage { + die "Usage:\n freeside-upgrade [ -d ] [ -q | -v ] user\n"; +} + +=head1 NAME + +freeside-upgrade - Upgrades database schema for new freeside verisons. + +=head1 SYNOPSIS + + freeside-upgrade [ -d ] [ -q | -v ] + +=head1 DESCRIPTION + +Reads your existing database schema and updates it to match the current schema, +adding any columns or tables necessary. + +Also performs other upgrade functions: + +=over 4 + +=item Calls FS:: Misc::prune::prune_applications (probably unnecessary every upgrade, but simply won't find any records to change) + +=item If necessary, moves your configuration information from the filesystem in /usr/local/etc/freeside/conf.<datasrc> to the database. + +=back + + [ -d ]: Dry run; output SQL statements (to STDOUT) only, but do not execute + them. + + [ -q ]: Run quietly. This may become the default at some point. + + [ -v ]: Run verbosely, sending debugging information to STDERR. This is the + current default. + +=head1 SEE ALSO + +=cut + diff --git a/FS/t/AccessRight.t b/FS/t/AccessRight.t new file mode 100644 index 000000000..a96684224 --- /dev/null +++ b/FS/t/AccessRight.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::AccessRight; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/CGI.t b/FS/t/CGI.t new file mode 100644 index 000000000..1b4e238b6 --- /dev/null +++ b/FS/t/CGI.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::CGI; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/ClientAPI.t b/FS/t/ClientAPI.t new file mode 100644 index 000000000..973d8dada --- /dev/null +++ b/FS/t/ClientAPI.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::ClientAPI; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/ClientAPI_SessionCache.t b/FS/t/ClientAPI_SessionCache.t new file mode 100644 index 000000000..605803eef --- /dev/null +++ b/FS/t/ClientAPI_SessionCache.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::ClientAPI_SessionCache; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/Conf.t b/FS/t/Conf.t new file mode 100644 index 000000000..a9f7653b3 --- /dev/null +++ b/FS/t/Conf.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::Conf; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/ConfDefaults.t b/FS/t/ConfDefaults.t new file mode 100644 index 000000000..433555adb --- /dev/null +++ b/FS/t/ConfDefaults.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::ConfDefaults; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/ConfItem.t b/FS/t/ConfItem.t new file mode 100644 index 000000000..c7932d7e3 --- /dev/null +++ b/FS/t/ConfItem.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::ConfItem; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/Cron-backup.t b/FS/t/Cron-backup.t new file mode 100644 index 000000000..847d41aed --- /dev/null +++ b/FS/t/Cron-backup.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::Cron::backup; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/Cron-bill.t b/FS/t/Cron-bill.t new file mode 100644 index 000000000..42c7b4f9e --- /dev/null +++ b/FS/t/Cron-bill.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::Cron::bill; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/Cron-vacuum.t b/FS/t/Cron-vacuum.t new file mode 100644 index 000000000..eaa6b762a --- /dev/null +++ b/FS/t/Cron-vacuum.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::Cron::vacuum; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/Daemon.t b/FS/t/Daemon.t new file mode 100644 index 000000000..24893fd94 --- /dev/null +++ b/FS/t/Daemon.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::Daemon; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/InitHandler.t b/FS/t/InitHandler.t new file mode 100644 index 000000000..0ce60c833 --- /dev/null +++ b/FS/t/InitHandler.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::InitHandler; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/Misc.t b/FS/t/Misc.t new file mode 100644 index 000000000..cc7751ab6 --- /dev/null +++ b/FS/t/Misc.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::Misc; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/Msgcat.t b/FS/t/Msgcat.t new file mode 100644 index 000000000..29e71b33c --- /dev/null +++ b/FS/t/Msgcat.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::Msgcat; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/Record.t b/FS/t/Record.t new file mode 100644 index 000000000..00de1eda3 --- /dev/null +++ b/FS/t/Record.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::Record; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/Report-Table-Monthly.t b/FS/t/Report-Table-Monthly.t new file mode 100644 index 000000000..6ff365d1c --- /dev/null +++ b/FS/t/Report-Table-Monthly.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::Report::Table::Monthly; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/Report-Table.t b/FS/t/Report-Table.t new file mode 100644 index 000000000..866d4981e --- /dev/null +++ b/FS/t/Report-Table.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::Report::Table; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/Report.t b/FS/t/Report.t new file mode 100644 index 000000000..76d6ea489 --- /dev/null +++ b/FS/t/Report.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::Report; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/SearchCache.t b/FS/t/SearchCache.t new file mode 100644 index 000000000..3c26f3528 --- /dev/null +++ b/FS/t/SearchCache.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::SearchCache; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/UID.t b/FS/t/UID.t new file mode 100644 index 000000000..9f7da4e89 --- /dev/null +++ b/FS/t/UID.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::UID; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/access_group.t b/FS/t/access_group.t new file mode 100644 index 000000000..be141099b --- /dev/null +++ b/FS/t/access_group.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::access_group; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/access_groupagent.t b/FS/t/access_groupagent.t new file mode 100644 index 000000000..aff1f2524 --- /dev/null +++ b/FS/t/access_groupagent.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::access_groupagent; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/access_right.t b/FS/t/access_right.t new file mode 100644 index 000000000..66cd362e8 --- /dev/null +++ b/FS/t/access_right.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::access_right; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/access_user.t b/FS/t/access_user.t new file mode 100644 index 000000000..cab679d8d --- /dev/null +++ b/FS/t/access_user.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::access_user; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/access_user_pref.t b/FS/t/access_user_pref.t new file mode 100644 index 000000000..282209830 --- /dev/null +++ b/FS/t/access_user_pref.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::access_user_pref; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/access_usergroup.t b/FS/t/access_usergroup.t new file mode 100644 index 000000000..383a7cf9c --- /dev/null +++ b/FS/t/access_usergroup.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::access_usergroup; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/acct_rt_transaction.t b/FS/t/acct_rt_transaction.t new file mode 100644 index 000000000..552bdc84a --- /dev/null +++ b/FS/t/acct_rt_transaction.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::acct_rt_transaction; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/acct_snarf.t b/FS/t/acct_snarf.t new file mode 100644 index 000000000..642760f20 --- /dev/null +++ b/FS/t/acct_snarf.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::acct_snarf; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/agent.t b/FS/t/agent.t new file mode 100644 index 000000000..769cce254 --- /dev/null +++ b/FS/t/agent.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::agent; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/agent_payment_gateway.t b/FS/t/agent_payment_gateway.t new file mode 100644 index 000000000..af78a9a27 --- /dev/null +++ b/FS/t/agent_payment_gateway.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::agent_payment_gateway; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/agent_type.t b/FS/t/agent_type.t new file mode 100644 index 000000000..99c66a151 --- /dev/null +++ b/FS/t/agent_type.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::agent_type; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/banned_pay.t b/FS/t/banned_pay.t new file mode 100644 index 000000000..bef1ff25f --- /dev/null +++ b/FS/t/banned_pay.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::banned_pay; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cdr.t b/FS/t/cdr.t new file mode 100644 index 000000000..1d1f3eb4e --- /dev/null +++ b/FS/t/cdr.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cdr; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cdr_calltype.t b/FS/t/cdr_calltype.t new file mode 100644 index 000000000..d4e13943e --- /dev/null +++ b/FS/t/cdr_calltype.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cdr_calltype; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cdr_carrier.t b/FS/t/cdr_carrier.t new file mode 100644 index 000000000..1e2161558 --- /dev/null +++ b/FS/t/cdr_carrier.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cdr_carrier; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cdr_type.t b/FS/t/cdr_type.t new file mode 100644 index 000000000..9dff15a32 --- /dev/null +++ b/FS/t/cdr_type.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cdr_type; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cdr_upstream_rate.t b/FS/t/cdr_upstream_rate.t new file mode 100644 index 000000000..f9458c527 --- /dev/null +++ b/FS/t/cdr_upstream_rate.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cdr_upstream_rate; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/clientapi_session.t b/FS/t/clientapi_session.t new file mode 100644 index 000000000..a6414c3d8 --- /dev/null +++ b/FS/t/clientapi_session.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::clientapi_session; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/clientapi_session_field.t b/FS/t/clientapi_session_field.t new file mode 100644 index 000000000..a9d4fa91a --- /dev/null +++ b/FS/t/clientapi_session_field.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::clientapi_session_field; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/conf.t b/FS/t/conf.t new file mode 100644 index 000000000..5e52079f6 --- /dev/null +++ b/FS/t/conf.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::conf; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_bill.t b/FS/t/cust_bill.t new file mode 100644 index 000000000..b43f08ee2 --- /dev/null +++ b/FS/t/cust_bill.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_bill_ApplicationCommon.t b/FS/t/cust_bill_ApplicationCommon.t new file mode 100644 index 000000000..fa03d3420 --- /dev/null +++ b/FS/t/cust_bill_ApplicationCommon.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_ApplicationCommon; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_bill_event.t b/FS/t/cust_bill_event.t new file mode 100644 index 000000000..0e2ca3e24 --- /dev/null +++ b/FS/t/cust_bill_event.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_event; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_bill_pay.t b/FS/t/cust_bill_pay.t new file mode 100644 index 000000000..001eed01e --- /dev/null +++ b/FS/t/cust_bill_pay.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_pay; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_bill_pay_batch.t b/FS/t/cust_bill_pay_batch.t new file mode 100644 index 000000000..bc3a8277c --- /dev/null +++ b/FS/t/cust_bill_pay_batch.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_pay_batch; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_bill_pay_pkg.t b/FS/t/cust_bill_pay_pkg.t new file mode 100644 index 000000000..b8fcddb41 --- /dev/null +++ b/FS/t/cust_bill_pay_pkg.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_pay_pkg; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_bill_pkg.t b/FS/t/cust_bill_pkg.t new file mode 100644 index 000000000..0e45bdb0c --- /dev/null +++ b/FS/t/cust_bill_pkg.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_pkg; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_bill_pkg_detail.t b/FS/t/cust_bill_pkg_detail.t new file mode 100644 index 000000000..ea6e3d125 --- /dev/null +++ b/FS/t/cust_bill_pkg_detail.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_pkg_detail; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_credit.t b/FS/t/cust_credit.t new file mode 100644 index 000000000..cddf75cff --- /dev/null +++ b/FS/t/cust_credit.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_credit; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_credit_bill.t b/FS/t/cust_credit_bill.t new file mode 100644 index 000000000..0ef54c3f1 --- /dev/null +++ b/FS/t/cust_credit_bill.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_credit_bill; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_credit_bill_pkg.t b/FS/t/cust_credit_bill_pkg.t new file mode 100644 index 000000000..4eb84c327 --- /dev/null +++ b/FS/t/cust_credit_bill_pkg.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_credit_bill_pkg; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_credit_refund.t b/FS/t/cust_credit_refund.t new file mode 100644 index 000000000..6b2b599f3 --- /dev/null +++ b/FS/t/cust_credit_refund.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_credit_refund; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_event.t b/FS/t/cust_event.t new file mode 100644 index 000000000..7812c5b6c --- /dev/null +++ b/FS/t/cust_event.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_event; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_main.t b/FS/t/cust_main.t new file mode 100644 index 000000000..b0ffbdb32 --- /dev/null +++ b/FS/t/cust_main.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_main; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_main_Mixin.t b/FS/t/cust_main_Mixin.t new file mode 100644 index 000000000..c8b929117 --- /dev/null +++ b/FS/t/cust_main_Mixin.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_main_Mixin; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_main_county.t b/FS/t/cust_main_county.t new file mode 100644 index 000000000..dd6119911 --- /dev/null +++ b/FS/t/cust_main_county.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_main_county; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_main_invoice.t b/FS/t/cust_main_invoice.t new file mode 100644 index 000000000..9661620e0 --- /dev/null +++ b/FS/t/cust_main_invoice.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_main_invoice; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_main_note.t b/FS/t/cust_main_note.t new file mode 100644 index 000000000..41a7bac0b --- /dev/null +++ b/FS/t/cust_main_note.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_main_note; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_pay.t b/FS/t/cust_pay.t new file mode 100644 index 000000000..f6d0b7571 --- /dev/null +++ b/FS/t/cust_pay.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_pay; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_pay_batch.t b/FS/t/cust_pay_batch.t new file mode 100644 index 000000000..02b572c15 --- /dev/null +++ b/FS/t/cust_pay_batch.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_pay_batch; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_pay_pending.t b/FS/t/cust_pay_pending.t new file mode 100644 index 000000000..9ab2b5e1a --- /dev/null +++ b/FS/t/cust_pay_pending.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_pay_pending; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_pay_refund.t b/FS/t/cust_pay_refund.t new file mode 100644 index 000000000..85d6c2316 --- /dev/null +++ b/FS/t/cust_pay_refund.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_pay_refund; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_pay_void.t b/FS/t/cust_pay_void.t new file mode 100644 index 000000000..dca9becd1 --- /dev/null +++ b/FS/t/cust_pay_void.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_pay_void; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_pkg.t b/FS/t/cust_pkg.t new file mode 100644 index 000000000..c6a686061 --- /dev/null +++ b/FS/t/cust_pkg.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_pkg; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_pkg_option.t b/FS/t/cust_pkg_option.t new file mode 100644 index 000000000..12314bf80 --- /dev/null +++ b/FS/t/cust_pkg_option.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_pkg_option; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_pkg_reason.t b/FS/t/cust_pkg_reason.t new file mode 100644 index 000000000..2f0a4fa4f --- /dev/null +++ b/FS/t/cust_pkg_reason.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_pkg_reason; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_refund.t b/FS/t/cust_refund.t new file mode 100644 index 000000000..91583da28 --- /dev/null +++ b/FS/t/cust_refund.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_refund; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_svc.t b/FS/t/cust_svc.t new file mode 100644 index 000000000..267d731db --- /dev/null +++ b/FS/t/cust_svc.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_svc; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_tax_exempt.t b/FS/t/cust_tax_exempt.t new file mode 100644 index 000000000..8af13e3aa --- /dev/null +++ b/FS/t/cust_tax_exempt.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_tax_exempt; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_tax_exempt_pkg.t b/FS/t/cust_tax_exempt_pkg.t new file mode 100644 index 000000000..099a0ce8a --- /dev/null +++ b/FS/t/cust_tax_exempt_pkg.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_tax_exempt_pkg; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/domain_record.t b/FS/t/domain_record.t new file mode 100644 index 000000000..794518ccf --- /dev/null +++ b/FS/t/domain_record.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::domain_record; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/export_svc.t b/FS/t/export_svc.t new file mode 100644 index 000000000..773c5dea7 --- /dev/null +++ b/FS/t/export_svc.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::export_svc; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/h_Common.t b/FS/t/h_Common.t new file mode 100644 index 000000000..174bb99e6 --- /dev/null +++ b/FS/t/h_Common.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::h_Common; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/h_cust_bill.t b/FS/t/h_cust_bill.t new file mode 100644 index 000000000..ceccb2a3d --- /dev/null +++ b/FS/t/h_cust_bill.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::h_cust_bill; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/h_cust_credit.t b/FS/t/h_cust_credit.t new file mode 100644 index 000000000..e20f4765a --- /dev/null +++ b/FS/t/h_cust_credit.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::h_cust_credit; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/h_cust_pay.t b/FS/t/h_cust_pay.t new file mode 100644 index 000000000..6a3fe95ab --- /dev/null +++ b/FS/t/h_cust_pay.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::h_cust_pay; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/h_cust_svc.t b/FS/t/h_cust_svc.t new file mode 100644 index 000000000..a7dabbea0 --- /dev/null +++ b/FS/t/h_cust_svc.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::h_cust_svc; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/h_cust_tax_exempt.t b/FS/t/h_cust_tax_exempt.t new file mode 100644 index 000000000..432238aa5 --- /dev/null +++ b/FS/t/h_cust_tax_exempt.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::h_cust_tax_exempt; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/h_domain_record.t b/FS/t/h_domain_record.t new file mode 100644 index 000000000..f48e72e9b --- /dev/null +++ b/FS/t/h_domain_record.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::h_domain_record; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/h_svc_acct.t b/FS/t/h_svc_acct.t new file mode 100644 index 000000000..9c94d0894 --- /dev/null +++ b/FS/t/h_svc_acct.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::h_svc_acct; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/h_svc_broadband.t b/FS/t/h_svc_broadband.t new file mode 100644 index 000000000..b8e5c7c82 --- /dev/null +++ b/FS/t/h_svc_broadband.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::h_svc_broadband; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/h_svc_domain.t b/FS/t/h_svc_domain.t new file mode 100644 index 000000000..87d2a09bd --- /dev/null +++ b/FS/t/h_svc_domain.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::h_svc_domain; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/h_svc_external.t b/FS/t/h_svc_external.t new file mode 100644 index 000000000..5248f876d --- /dev/null +++ b/FS/t/h_svc_external.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::h_svc_external; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/h_svc_forward.t b/FS/t/h_svc_forward.t new file mode 100644 index 000000000..64731d562 --- /dev/null +++ b/FS/t/h_svc_forward.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::h_svc_forward; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/h_svc_www.t b/FS/t/h_svc_www.t new file mode 100644 index 000000000..07558ce65 --- /dev/null +++ b/FS/t/h_svc_www.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::h_svc_www; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/inventory_class.t b/FS/t/inventory_class.t new file mode 100644 index 000000000..80b2fa210 --- /dev/null +++ b/FS/t/inventory_class.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::inventory_class; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/inventory_item.t b/FS/t/inventory_item.t new file mode 100644 index 000000000..8ce9d677c --- /dev/null +++ b/FS/t/inventory_item.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::inventory_item; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/msgcat.t b/FS/t/msgcat.t new file mode 100644 index 000000000..c38c63935 --- /dev/null +++ b/FS/t/msgcat.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::msgcat; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/nas.t b/FS/t/nas.t new file mode 100644 index 000000000..6f8ae36d2 --- /dev/null +++ b/FS/t/nas.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::nas; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/option_Common.t b/FS/t/option_Common.t new file mode 100644 index 000000000..ad261415c --- /dev/null +++ b/FS/t/option_Common.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::option_Common; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_bill_event.t b/FS/t/part_bill_event.t new file mode 100644 index 000000000..5626a9f97 --- /dev/null +++ b/FS/t/part_bill_event.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_bill_event; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_event-Action.t b/FS/t/part_event-Action.t new file mode 100644 index 000000000..a6652776c --- /dev/null +++ b/FS/t/part_event-Action.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_event::Action; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_event-Condition.t b/FS/t/part_event-Condition.t new file mode 100644 index 000000000..c44a438fd --- /dev/null +++ b/FS/t/part_event-Condition.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_event::Condition; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_event.t b/FS/t/part_event.t new file mode 100644 index 000000000..027b20cfc --- /dev/null +++ b/FS/t/part_event.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_event; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_event_condition.t b/FS/t/part_event_condition.t new file mode 100644 index 000000000..fa5a05cf3 --- /dev/null +++ b/FS/t/part_event_condition.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_event_condition; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_event_condition_option.t b/FS/t/part_event_condition_option.t new file mode 100644 index 000000000..492fc82ef --- /dev/null +++ b/FS/t/part_event_condition_option.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_event_condition_option; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_event_condition_option_option.t b/FS/t/part_event_condition_option_option.t new file mode 100644 index 000000000..f714011ad --- /dev/null +++ b/FS/t/part_event_condition_option_option.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_event_condition_option_option; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_event_option.t b/FS/t/part_event_option.t new file mode 100644 index 000000000..546a78fd8 --- /dev/null +++ b/FS/t/part_event_option.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_event_option; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-acct_sql.t b/FS/t/part_export-acct_sql.t new file mode 100644 index 000000000..9eed47259 --- /dev/null +++ b/FS/t/part_export-acct_sql.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::acct_sql; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-apache.t b/FS/t/part_export-apache.t new file mode 100644 index 000000000..b9995080f --- /dev/null +++ b/FS/t/part_export-apache.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::apache; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-bind.t b/FS/t/part_export-bind.t new file mode 100644 index 000000000..d0c96be40 --- /dev/null +++ b/FS/t/part_export-bind.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::bind; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-bind_slave.t b/FS/t/part_export-bind_slave.t new file mode 100644 index 000000000..c6a038610 --- /dev/null +++ b/FS/t/part_export-bind_slave.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::bind_slave; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-bsdshell.t b/FS/t/part_export-bsdshell.t new file mode 100644 index 000000000..eaf417a70 --- /dev/null +++ b/FS/t/part_export-bsdshell.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::bsdshell; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-communigate_pro.t b/FS/t/part_export-communigate_pro.t new file mode 100644 index 000000000..88b8b64e0 --- /dev/null +++ b/FS/t/part_export-communigate_pro.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::communigate_pro; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-communigate_pro_singledomain.t b/FS/t/part_export-communigate_pro_singledomain.t new file mode 100644 index 000000000..6f8a64e0f --- /dev/null +++ b/FS/t/part_export-communigate_pro_singledomain.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::communigate_pro_singledomain; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-cp.t b/FS/t/part_export-cp.t new file mode 100644 index 000000000..bbefa6c1b --- /dev/null +++ b/FS/t/part_export-cp.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::cp; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-cyrus.t b/FS/t/part_export-cyrus.t new file mode 100644 index 000000000..e0b3f350e --- /dev/null +++ b/FS/t/part_export-cyrus.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::cyrus; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-domain_shellcommands.t b/FS/t/part_export-domain_shellcommands.t new file mode 100644 index 000000000..a2a44fbfb --- /dev/null +++ b/FS/t/part_export-domain_shellcommands.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::domain_shellcommands; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-forward_shellcommands.t b/FS/t/part_export-forward_shellcommands.t new file mode 100644 index 000000000..78ca68d10 --- /dev/null +++ b/FS/t/part_export-forward_shellcommands.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::forward_shellcommands; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-http.t b/FS/t/part_export-http.t new file mode 100644 index 000000000..ea41b939f --- /dev/null +++ b/FS/t/part_export-http.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::http; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-infostreet.t b/FS/t/part_export-infostreet.t new file mode 100644 index 000000000..1b3341825 --- /dev/null +++ b/FS/t/part_export-infostreet.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::infostreet; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-ldap.t b/FS/t/part_export-ldap.t new file mode 100644 index 000000000..826c3418d --- /dev/null +++ b/FS/t/part_export-ldap.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::ldap; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-null.t b/FS/t/part_export-null.t new file mode 100644 index 000000000..055cdcee6 --- /dev/null +++ b/FS/t/part_export-null.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::null; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-passwdfile.t b/FS/t/part_export-passwdfile.t new file mode 100644 index 000000000..0f18f3044 --- /dev/null +++ b/FS/t/part_export-passwdfile.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::passwdfile; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-postfix.t b/FS/t/part_export-postfix.t new file mode 100644 index 000000000..9518caad6 --- /dev/null +++ b/FS/t/part_export-postfix.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::postfix; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-radiator.t b/FS/t/part_export-radiator.t new file mode 100644 index 000000000..546e9de30 --- /dev/null +++ b/FS/t/part_export-radiator.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::radiator; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-router.t b/FS/t/part_export-router.t new file mode 100644 index 000000000..54e4b63de --- /dev/null +++ b/FS/t/part_export-router.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::router; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-shellcommands.t b/FS/t/part_export-shellcommands.t new file mode 100644 index 000000000..7bb47d3f8 --- /dev/null +++ b/FS/t/part_export-shellcommands.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::shellcommands; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-shellcommands_withdomain.t b/FS/t/part_export-shellcommands_withdomain.t new file mode 100644 index 000000000..c0bd1bbb0 --- /dev/null +++ b/FS/t/part_export-shellcommands_withdomain.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::shellcommands_withdomain; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-sqlmail.t b/FS/t/part_export-sqlmail.t new file mode 100644 index 000000000..b048a75a5 --- /dev/null +++ b/FS/t/part_export-sqlmail.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::sqlmail; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-sqlradius.t b/FS/t/part_export-sqlradius.t new file mode 100644 index 000000000..5fb23a5a6 --- /dev/null +++ b/FS/t/part_export-sqlradius.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::sqlradius; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-sqlradius_withdomain.t b/FS/t/part_export-sqlradius_withdomain.t new file mode 100644 index 000000000..504bf679f --- /dev/null +++ b/FS/t/part_export-sqlradius_withdomain.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::sqlradius_withdomain; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-sysvshell.t b/FS/t/part_export-sysvshell.t new file mode 100644 index 000000000..7fc24acb1 --- /dev/null +++ b/FS/t/part_export-sysvshell.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::sysvshell; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-textradius.t b/FS/t/part_export-textradius.t new file mode 100644 index 000000000..d8a48a0c8 --- /dev/null +++ b/FS/t/part_export-textradius.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::textradius; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-vpopmail.t b/FS/t/part_export-vpopmail.t new file mode 100644 index 000000000..2e37114a2 --- /dev/null +++ b/FS/t/part_export-vpopmail.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::vpopmail; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-www_shellcommands.t b/FS/t/part_export-www_shellcommands.t new file mode 100644 index 000000000..2ea79cf97 --- /dev/null +++ b/FS/t/part_export-www_shellcommands.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::www_shellcommands; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export.t b/FS/t/part_export.t new file mode 100644 index 000000000..26b398791 --- /dev/null +++ b/FS/t/part_export.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export_option.t b/FS/t/part_export_option.t new file mode 100644 index 000000000..13200c213 --- /dev/null +++ b/FS/t/part_export_option.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export_option; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-flat.t b/FS/t/part_pkg-flat.t new file mode 100644 index 000000000..3eee7a7c7 --- /dev/null +++ b/FS/t/part_pkg-flat.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::flat; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-flat_comission.t b/FS/t/part_pkg-flat_comission.t new file mode 100644 index 000000000..fefa57eb4 --- /dev/null +++ b/FS/t/part_pkg-flat_comission.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::flat_comission; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-flat_comission_cust.t b/FS/t/part_pkg-flat_comission_cust.t new file mode 100644 index 000000000..05d3ac417 --- /dev/null +++ b/FS/t/part_pkg-flat_comission_cust.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::flat_comission_cust; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-flat_comission_pkg.t b/FS/t/part_pkg-flat_comission_pkg.t new file mode 100644 index 000000000..851b58db1 --- /dev/null +++ b/FS/t/part_pkg-flat_comission_pkg.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::flat_comission_pkg; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-flat_delayed.t b/FS/t/part_pkg-flat_delayed.t new file mode 100644 index 000000000..ed638462b --- /dev/null +++ b/FS/t/part_pkg-flat_delayed.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::flat_delayed; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-prorate.t b/FS/t/part_pkg-prorate.t new file mode 100644 index 000000000..d32b1c095 --- /dev/null +++ b/FS/t/part_pkg-prorate.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::prorate; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-sesmon_hour.t b/FS/t/part_pkg-sesmon_hour.t new file mode 100644 index 000000000..4f02cfcf4 --- /dev/null +++ b/FS/t/part_pkg-sesmon_hour.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::sesmon_hour; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-sesmon_minute.t b/FS/t/part_pkg-sesmon_minute.t new file mode 100644 index 000000000..6ceaa3ce2 --- /dev/null +++ b/FS/t/part_pkg-sesmon_minute.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::sesmon_minute; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-sql_external.t b/FS/t/part_pkg-sql_external.t new file mode 100644 index 000000000..366ed01ef --- /dev/null +++ b/FS/t/part_pkg-sql_external.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::sql_external; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-sql_generic.t b/FS/t/part_pkg-sql_generic.t new file mode 100644 index 000000000..299a7c67c --- /dev/null +++ b/FS/t/part_pkg-sql_generic.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::sql_generic; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-sqlradacct_hour.t b/FS/t/part_pkg-sqlradacct_hour.t new file mode 100644 index 000000000..2a4ed7954 --- /dev/null +++ b/FS/t/part_pkg-sqlradacct_hour.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::sqlradacct_hour; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-subscription.t b/FS/t/part_pkg-subscription.t new file mode 100644 index 000000000..10b44790f --- /dev/null +++ b/FS/t/part_pkg-subscription.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::subscription; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-voip_cdr.t b/FS/t/part_pkg-voip_cdr.t new file mode 100644 index 000000000..2d988a34f --- /dev/null +++ b/FS/t/part_pkg-voip_cdr.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::voip_cdr; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-voip_sqlradacct.t b/FS/t/part_pkg-voip_sqlradacct.t new file mode 100644 index 000000000..8d542044d --- /dev/null +++ b/FS/t/part_pkg-voip_sqlradacct.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::voip_sqlradacct; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg.t b/FS/t/part_pkg.t new file mode 100644 index 000000000..fd96073f9 --- /dev/null +++ b/FS/t/part_pkg.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg_option.t b/FS/t/part_pkg_option.t new file mode 100644 index 000000000..6239b2d7b --- /dev/null +++ b/FS/t/part_pkg_option.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg_option; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg_taxclass.t b/FS/t/part_pkg_taxclass.t new file mode 100644 index 000000000..bbe407314 --- /dev/null +++ b/FS/t/part_pkg_taxclass.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg_taxclass; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pop_local.t b/FS/t/part_pop_local.t new file mode 100644 index 000000000..4e4ad17f5 --- /dev/null +++ b/FS/t/part_pop_local.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pop_local; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_referral.t b/FS/t/part_referral.t new file mode 100644 index 000000000..d20b97930 --- /dev/null +++ b/FS/t/part_referral.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_referral; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_svc.t b/FS/t/part_svc.t new file mode 100644 index 000000000..bdb2a7aca --- /dev/null +++ b/FS/t/part_svc.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_svc; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_svc_column.t b/FS/t/part_svc_column.t new file mode 100644 index 000000000..467025c1e --- /dev/null +++ b/FS/t/part_svc_column.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_svc_column; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/pay_batch.t b/FS/t/pay_batch.t new file mode 100644 index 000000000..c43133dc2 --- /dev/null +++ b/FS/t/pay_batch.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::pay_batch; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/payby.t b/FS/t/payby.t new file mode 100644 index 000000000..7430bc8e5 --- /dev/null +++ b/FS/t/payby.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::payby; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/payinfo_Mixin.t b/FS/t/payinfo_Mixin.t new file mode 100644 index 000000000..3567c8e08 --- /dev/null +++ b/FS/t/payinfo_Mixin.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::payinfo_Mixin; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/payment_gateway.t b/FS/t/payment_gateway.t new file mode 100644 index 000000000..4bcc78153 --- /dev/null +++ b/FS/t/payment_gateway.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::payment_gateway; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/payment_gateway_option.t b/FS/t/payment_gateway_option.t new file mode 100644 index 000000000..19e645121 --- /dev/null +++ b/FS/t/payment_gateway_option.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::payment_gateway_option; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/pkg_class.t b/FS/t/pkg_class.t new file mode 100644 index 000000000..fb3774f8c --- /dev/null +++ b/FS/t/pkg_class.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::pkg_class; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/pkg_referral.t b/FS/t/pkg_referral.t new file mode 100644 index 000000000..ff047baa3 --- /dev/null +++ b/FS/t/pkg_referral.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::pkg_referral; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/pkg_svc.t b/FS/t/pkg_svc.t new file mode 100644 index 000000000..77d34295a --- /dev/null +++ b/FS/t/pkg_svc.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::pkg_svc; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/port.t b/FS/t/port.t new file mode 100644 index 000000000..46377aaf9 --- /dev/null +++ b/FS/t/port.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::port; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/prepay_credit.t b/FS/t/prepay_credit.t new file mode 100644 index 000000000..e7626bdf1 --- /dev/null +++ b/FS/t/prepay_credit.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::prepay_credit; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/queue.t b/FS/t/queue.t new file mode 100644 index 000000000..43e33730e --- /dev/null +++ b/FS/t/queue.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::queue; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/queue_arg.t b/FS/t/queue_arg.t new file mode 100644 index 000000000..cf3f91dfe --- /dev/null +++ b/FS/t/queue_arg.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::queue_arg; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/queue_depend.t b/FS/t/queue_depend.t new file mode 100644 index 000000000..8eaa2cdb3 --- /dev/null +++ b/FS/t/queue_depend.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::queue_depend; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/raddb.t b/FS/t/raddb.t new file mode 100644 index 000000000..ac28d0798 --- /dev/null +++ b/FS/t/raddb.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::raddb; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/radius_usergroup.t b/FS/t/radius_usergroup.t new file mode 100644 index 000000000..325742cf5 --- /dev/null +++ b/FS/t/radius_usergroup.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::radius_usergroup; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/rate.t b/FS/t/rate.t new file mode 100644 index 000000000..ae9c8bb31 --- /dev/null +++ b/FS/t/rate.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::rate; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/rate_detail.t b/FS/t/rate_detail.t new file mode 100644 index 000000000..163972e81 --- /dev/null +++ b/FS/t/rate_detail.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::rate_detail; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/rate_prefix.t b/FS/t/rate_prefix.t new file mode 100644 index 000000000..d4bd51363 --- /dev/null +++ b/FS/t/rate_prefix.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::rate_prefix; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/rate_region.t b/FS/t/rate_region.t new file mode 100644 index 000000000..6e0db8f27 --- /dev/null +++ b/FS/t/rate_region.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::rate_region; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/reason.t b/FS/t/reason.t new file mode 100644 index 000000000..d5e4dc9e7 --- /dev/null +++ b/FS/t/reason.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::reason; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/reason_type.t b/FS/t/reason_type.t new file mode 100644 index 000000000..279d5b950 --- /dev/null +++ b/FS/t/reason_type.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::reason_type; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/reg_code.t b/FS/t/reg_code.t new file mode 100644 index 000000000..4b9599078 --- /dev/null +++ b/FS/t/reg_code.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::reg_code; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/reg_code_pkg.t b/FS/t/reg_code_pkg.t new file mode 100644 index 000000000..7f89ffaee --- /dev/null +++ b/FS/t/reg_code_pkg.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::reg_code_pkg; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/registrar.t b/FS/t/registrar.t new file mode 100644 index 000000000..a6ba13437 --- /dev/null +++ b/FS/t/registrar.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::registrar; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/session.t b/FS/t/session.t new file mode 100644 index 000000000..c4b714ea4 --- /dev/null +++ b/FS/t/session.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::session; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/svc_Common.t b/FS/t/svc_Common.t new file mode 100644 index 000000000..ed49e1e49 --- /dev/null +++ b/FS/t/svc_Common.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::svc_Common; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/svc_External_Common.t b/FS/t/svc_External_Common.t new file mode 100644 index 000000000..a0b2ea2fd --- /dev/null +++ b/FS/t/svc_External_Common.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::svc_External_Common; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/svc_Parent_Mixin.t b/FS/t/svc_Parent_Mixin.t new file mode 100644 index 000000000..ed9923fc0 --- /dev/null +++ b/FS/t/svc_Parent_Mixin.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::svc_Parent_Mixin; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/svc_acct.t b/FS/t/svc_acct.t new file mode 100644 index 000000000..9ca78c9d1 --- /dev/null +++ b/FS/t/svc_acct.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::svc_acct; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/svc_acct_pop.t b/FS/t/svc_acct_pop.t new file mode 100644 index 000000000..e612c40af --- /dev/null +++ b/FS/t/svc_acct_pop.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::svc_acct_pop; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/svc_broadband.t b/FS/t/svc_broadband.t new file mode 100644 index 000000000..02dc1124a --- /dev/null +++ b/FS/t/svc_broadband.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::svc_broadband; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/svc_domain.t b/FS/t/svc_domain.t new file mode 100644 index 000000000..4d91898ac --- /dev/null +++ b/FS/t/svc_domain.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::svc_domain; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/svc_external.t b/FS/t/svc_external.t new file mode 100644 index 000000000..20a676784 --- /dev/null +++ b/FS/t/svc_external.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::svc_external; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/svc_forward.t b/FS/t/svc_forward.t new file mode 100644 index 000000000..d653d34ef --- /dev/null +++ b/FS/t/svc_forward.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::svc_forward; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/svc_phone.t b/FS/t/svc_phone.t new file mode 100644 index 000000000..15b9ca275 --- /dev/null +++ b/FS/t/svc_phone.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::svc_phone; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/svc_www.t b/FS/t/svc_www.t new file mode 100644 index 000000000..eb4e83fbc --- /dev/null +++ b/FS/t/svc_www.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::svc_www; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/type_pkgs.t b/FS/t/type_pkgs.t new file mode 100644 index 000000000..98401805c --- /dev/null +++ b/FS/t/type_pkgs.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::type_pkgs; +$loaded=1; +print "ok 1\n"; diff --git a/INSTALL b/INSTALL new file mode 100644 index 000000000..4b9b0853c --- /dev/null +++ b/INSTALL @@ -0,0 +1 @@ +See httemplate/docs/index.html diff --git a/Makefile b/Makefile new file mode 100644 index 000000000..a820cb1e6 --- /dev/null +++ b/Makefile @@ -0,0 +1,363 @@ +#!/usr/bin/make + +#solaris and perhaps other very weirdass /bin/sh +#SHELL="/bin/ksh" + +DB_TYPE = Pg +#DB_TYPE = mysql + +DB_USER = freeside +DB_PASSWORD= + +DATASOURCE = DBI:${DB_TYPE}:dbname=freeside + +#changable now (some things which should go to the others still go to CONF) +FREESIDE_CONF = /usr/local/etc/freeside +FREESIDE_LOG = /usr/local/etc/freeside +FREESIDE_LOCK = /usr/local/etc/freeside +FREESIDE_CACHE = /usr/local/etc/freeside +FREESIDE_EXPORT = /usr/local/etc/freeside + +MASON_HANDLER = ${FREESIDE_CONF}/handler.pl +MASONDATA = ${FREESIDE_CACHE}/masondata + +#mod_perl v1 +#APACHE_VERSION = 1 +#mod_perl v2 prereleases up to and including 1.999_21 +#APACHE_VERSON = 1.99 +#mod_perl v2 proper and prereleases 1.999_22 and after +APACHE_VERSION = 2 + +#deb +FREESIDE_DOCUMENT_ROOT = /var/www/freeside +#redhat, fedora, mandrake +#FREESIDE_DOCUMENT_ROOT = /var/www/html/freeside +#freebsd +#FREESIDE_DOCUMENT_ROOT = /usr/local/www/data/freeside +#openbsd +#FREESIDE_DOCUMENT_ROOT = /var/www/htdocs/freeside +#suse +#FREESIDE_DOCUMENT_ROOT = /srv/www/htdocs/freeside +#apache +#FREESIDE_DOCUMENT_ROOT = /usr/local/apache/htdocs/freeside + +#deb, redhat, fedora, mandrake, suse, others? +INIT_FILE = /etc/init.d/freeside +#freebsd +#INIT_FILE = /usr/local/etc/rc.d/011.freeside.sh + +#deb +INIT_INSTALL = /usr/sbin/update-rc.d freeside defaults 21 20 +#redhat, fedora +#INIT_INSTALL = /sbin/chkconfig freeside on +#not necessary (freebsd) +#INIT_INSTALL = /usr/bin/true + +#deb, suse +#HTTPD_RESTART = /etc/init.d/apache restart +#deb w/apache2 +HTTPD_RESTART = /etc/init.d/apache2 restart +#redhat, fedora, mandrake +#HTTPD_RESTART = /etc/init.d/httpd restart +#freebsd +#HTTPD_RESTART = /usr/local/etc/rc.d/apache.sh stop || true; sleep 10; /usr/local/etc/rc.d/apache.sh start +#openbsd +#HTTPD_RESTART = kill -TERM `cat /var/www/logs/httpd.pid`; sleep 10; /usr/sbin/httpd -u -DSSL +#apache +#HTTPD_RESTART = /usr/local/apache/bin/apachectl stop; sleep 10; /usr/local/apache/bin/apachectl startssl + +#(an include directory, not a file, "Include /etc/apachew/conf.d" in httpd.conf) +#deb (3.1+), +APACHE_CONF = /etc/apache2/conf.d + +FREESIDE_RESTART = ${INIT_FILE} restart + +#deb, redhat, fedora, mandrake, suse, others? +INSTALLGROUP = root +#freebsd, openbsd +#INSTALLGROUP = wheel + +#edit the stuff below to have the daemons start + +QUEUED_USER=fs_queue + +SELFSERVICE_USER = fs_selfservice +#never run on the same machine in production!!! +SELFSERVICE_MACHINES = localhost +# SELFSERVICE_MACHINES = www.example.com +# SELFSERVICE_MACHINES = web1.example.com web2.example.com + +#user with sudo access on SELFSERVICE_MACHINES for automated self-service +#installation. +SELFSERVICE_INSTALL_USER = ivan +SELFSERVICE_INSTALL_USERADD = /usr/sbin/useradd +#SELFSERVICE_INSTALL_USERADD = "/usr/sbin/pw useradd" + +#RT_ENABLED = 0 +RT_ENABLED = 1 +RT_DOMAIN = example.com +RT_TIMEZONE = US/Pacific +#RT_TIMEZONE = US/Eastern +FREESIDE_URL = "http://localhost/freeside/" + +#for now, same db as specified in DATASOURCE... eventually, otherwise? +RT_DB_DATABASE = freeside + +#--- + + +#rt/config.layout.in +RT_PATH = /opt/rt3 + +#only used for dev kludge now, not a big deal +FREESIDE_PATH = `pwd` +PERL_INC_DEV_KLUDGE = /usr/local/share/perl/5.8.8/ + +VERSION=1.9.0cvs +TAG=freeside_1_9_0 + +help: + @echo "supported targets:" + @echo " create-database create-config" + @echo " install deploy" + @echo " configure-rt create-rt" + @echo " clean help" + @echo + @echo " install-docs install-perl-modules" + @echo " install-init install-apache" + @echo " install-rt" + @echo " install-selfservice update-selfservice" + @echo + @echo " dev dev-docs dev-perl-modules" + @echo + @echo " masondocs alldocs docs" + @echo " wikiman" + @echo " perl-modules" + #@echo + #@echo " upload-docs release update-webdemo" + + +masondocs: httemplate/* httemplate/*/* httemplate/*/*/* httemplate/*/*/*/* + rm -rf masondocs + cp -pr httemplate masondocs + touch masondocs + +alldocs: masondocs + +docs: + make masondocs + +wikiman: + chmod a+rx ./bin/pod2x + ./bin/pod2x + +install-docs: docs + [ -e ${FREESIDE_DOCUMENT_ROOT} ] && mv ${FREESIDE_DOCUMENT_ROOT} ${FREESIDE_DOCUMENT_ROOT}.`date +%Y%m%d%H%M%S` || true + cp -r masondocs ${FREESIDE_DOCUMENT_ROOT} + chown -R freeside:freeside ${FREESIDE_DOCUMENT_ROOT} + cp htetc/handler.pl ${MASON_HANDLER} + perl -p -i -e "\ + s'%%%FREESIDE_DOCUMENT_ROOT%%%'${FREESIDE_DOCUMENT_ROOT}'g; \ + s'%%%RT_ENABLED%%%'${RT_ENABLED}'g; \ + s'%%%MASONDATA%%%'${MASONDATA}'g;\ + " ${MASON_HANDLER} + [ ! -e ${MASONDATA} ] && mkdir ${MASONDATA} || true + chown -R freeside ${MASONDATA} + +dev-docs: + [ -e ${FREESIDE_DOCUMENT_ROOT} ] && mv ${FREESIDE_DOCUMENT_ROOT} ${FREESIDE_DOCUMENT_ROOT}.`date +%Y%m%d%H%M%S` || true + ln -s ${FREESIDE_PATH}/httemplate ${FREESIDE_DOCUMENT_ROOT} + cp htetc/handler.pl ${MASON_HANDLER} + perl -p -i -e "\ + s'%%%FREESIDE_DOCUMENT_ROOT%%%'${FREESIDE_DOCUMENT_ROOT}'g; \ + s'%%%RT_ENABLED%%%'${RT_ENABLED}'g; \ + s'%%%MASONDATA%%%'${MASONDATA}'g;\ + s'###use Module::Refresh;###'use Module::Refresh;'; \ + s'###Module::Refresh->refresh;###'Module::Refresh->refresh;'; \ + " ${MASON_HANDLER} || true + + +perl-modules: + cd FS; \ + [ -e Makefile ] || perl Makefile.PL; \ + make; \ + perl -p -i -e "\ + s/%%%VERSION%%%/${VERSION}/g;\ + " blib/lib/FS.pm;\ + perl -p -i -e "\ + s|%%%FREESIDE_CONF%%%|${FREESIDE_CONF}|g;\ + s|%%%FREESIDE_CACHE%%%|${FREESIDE_CACHE}|g;\ + " blib/lib/FS/*.pm;\ + perl -p -i -e "\ + s|%%%FREESIDE_EXPORT%%%|${FREESIDE_EXPORT}|g;\ + " blib/lib/FS/part_export/*.pm;\ + perl -p -i -e "\ + s|%%%FREESIDE_CONF%%%|${FREESIDE_CONF}|g;\ + s|%%%FREESIDE_LOG%%%|${FREESIDE_LOG}|g;\ + s|%%%FREESIDE_LOCK%%%|${FREESIDE_LOCK}|g;\ + s|%%%FREESIDE_CACHE%%%|${FREESIDE_CACHE}|g;\ + s|%%%FREESIDE_EXPORT%%%|${FREESIDE_EXPORT}|g;\ + " blib/script/* + +install-perl-modules: perl-modules + [ -L ${PERL_INC_DEV_KLUDGE}/FS ] \ + && rm ${PERL_INC_DEV_KLUDGE}/FS \ + && mv ${PERL_INC_DEV_KLUDGE}/FS.old ${PERL_INC_DEV_KLUDGE}/FS \ + || true + cd FS; \ + make install UNINST=1 + +dev-perl-modules: perl-modules + [ -d ${PERL_INC_DEV_KLUDGE}/FS -a ! -L ${PERL_INC_DEV_KLUDGE}/FS ] \ + && mv ${PERL_INC_DEV_KLUDGE}/FS ${PERL_INC_DEV_KLUDGE}/FS.old \ + || true + + rm -rf ${PERL_INC_DEV_KLUDGE}/FS + ln -sf ${FREESIDE_PATH}/FS/blib/lib/FS ${PERL_INC_DEV_KLUDGE}/FS + +install-init: + #[ -e ${INIT_FILE} ] || install -o root -g ${INSTALLGROUP} -m 711 init.d/freeside-init ${INIT_FILE} + install -o root -g ${INSTALLGROUP} -m 711 init.d/freeside-init ${INIT_FILE} + perl -p -i -e "\ + s/%%%QUEUED_USER%%%/${QUEUED_USER}/g;\ + s/%%%SELFSERVICE_USER%%%/${SELFSERVICE_USER}/g;\ + s/%%%SELFSERVICE_MACHINES%%%/${SELFSERVICE_MACHINES}/g;\ + " ${INIT_FILE} + ${INIT_INSTALL} + +install-apache: + [ -e ${APACHE_CONF}/freeside-base.conf ] && rm ${APACHE_CONF}/freeside-base.conf || true + [ -d ${APACHE_CONF} ] && \ + ( install -o root -m 755 htetc/freeside-base${APACHE_VERSION}.conf ${APACHE_CONF} && \ + ( [ ${RT_ENABLED} -eq 1 ] && install -o root -m 755 htetc/freeside-rt.conf ${APACHE_CONF} || true ) && \ + perl -p -i -e "\ + s'%%%FREESIDE_DOCUMENT_ROOT%%%'${FREESIDE_DOCUMENT_ROOT}'g; \ + s'%%%MASON_HANDLER%%%'${MASON_HANDLER}'g; \ + " ${APACHE_CONF}/freeside-*.conf \ + ) || true + +install-selfservice: + [ -e ~freeside ] || cp -pr /etc/skel ~freeside && chown -R freeside ~freeside + [ -e ~freeside/.ssh/id_dsa.pub ] || su - freeside -c 'ssh-keygen -t dsa' + for MACHINE in ${SELFSERVICE_MACHINES}; do \ + scp -r fs_selfservice/FS-SelfService ${SELFSERVICE_INSTALL_USER}@$$MACHINE:. ;\ + ssh ${SELFSERVICE_INSTALL_USER}@$$MACHINE "cd FS-SelfService; perl Makefile.PL && make" ;\ + ssh ${SELFSERVICE_INSTALL_USER}@$$MACHINE "cd FS-SelfService; sudo make install" ;\ + scp ~freeside/.ssh/id_dsa.pub ${SELFSERVICE_INSTALL_USER}@$$MACHINE:. ;\ + ssh ${SELFSERVICE_INSTALL_USER}@$$MACHINE "sudo ${SELFSERVICE_INSTALL_USERADD} freeside; sudo install -d -o freeside -m 600 ~freeside/.ssh/; sudo install -o freeside -m 600 ./id_dsa.pub ~freeside/.ssh/authorized_keys" ;\ + ssh ${SELFSERVICE_INSTALL_USER}@$$MACHINE "sudo install -o freeside -d /usr/local/freeside" ;\ + done + +update-selfservice: + for MACHINE in ${SELFSERVICE_MACHINES}; do \ + RSYNC_RSH=ssh rsync -rlptz fs_selfservice/FS-SelfService/ ${SELFSERVICE_INSTALL_USER}@$$MACHINE:FS-SelfService ;\ + ssh ${SELFSERVICE_INSTALL_USER}@$$MACHINE "cd FS-SelfService; perl Makefile.PL && make" ;\ + ssh ${SELFSERVICE_INSTALL_USER}@$$MACHINE "cd FS-SelfService; sudo make install" ;\ + done + +install: install-perl-modules install-docs install-init install-apache install-rt + +deploy: install + ${HTTPD_RESTART} + ${FREESIDE_RESTART} + +dev: dev-perl-modules dev-docs + +create-database: + perl -e 'use DBIx::DataSource qw( create_database ); create_database( "${DATASOURCE}", "${DB_USER}", "${DB_PASSWORD}" ) or die $$DBIx::DataSource::errstr;' + +create-config: install-perl-modules + [ -e ${FREESIDE_CONF} ] && mv ${FREESIDE_CONF} ${FREESIDE_CONF}.`date +%Y%m%d%H%M%S` || true + install -d -o freeside ${FREESIDE_CONF} + + touch ${FREESIDE_CONF}/secrets + chown freeside ${FREESIDE_CONF}/secrets + chmod 600 ${FREESIDE_CONF}/secrets + + echo -e "${DATASOURCE}\n${DB_USER}\n${DB_PASSWORD}" >${FREESIDE_CONF}/secrets + chmod 600 ${FREESIDE_CONF}/secrets + chown freeside ${FREESIDE_CONF}/secrets + + mkdir "${FREESIDE_CONF}/conf.${DATASOURCE}" + rm -rf conf/registries #old dirs just won't go away + #cp conf/[a-z]* "${FREESIDE_CONF}/conf.${DATASOURCE}" + cp `ls -d conf/[a-z]* | grep -v CVS` "${FREESIDE_CONF}/conf.${DATASOURCE}" + chown -R freeside "${FREESIDE_CONF}/conf.${DATASOURCE}" + + mkdir "${FREESIDE_CACHE}/counters.${DATASOURCE}" + chown freeside "${FREESIDE_CACHE}/counters.${DATASOURCE}" + + mkdir "${FREESIDE_CACHE}/cache.${DATASOURCE}" + chown freeside "${FREESIDE_CACHE}/cache.${DATASOURCE}" + + mkdir "${FREESIDE_EXPORT}/export.${DATASOURCE}" + chown freeside "${FREESIDE_EXPORT}/export.${DATASOURCE}" + +configure-rt: + cd rt; \ + cp config.layout.in config.layout; \ + perl -p -i -e "\ + s'%%%FREESIDE_DOCUMENT_ROOT%%%'${FREESIDE_DOCUMENT_ROOT}'g;\ + s'%%%MASONDATA%%%'${MASONDATA}'g;\ + " config.layout; \ + ./configure --enable-layout=Freeside\ + --with-db-type=${DB_TYPE} \ + --with-db-dba=${DB_USER} \ + --with-db-database=${RT_DB_DATABASE} \ + --with-db-rt-user=${DB_USER} \ + --with-db-rt-pass=${DB_PASSWORD} \ + --with-web-user=freeside \ + --with-web-group=freeside \ + --with-rt-group=freeside + +create-rt: configure-rt + [ -d /opt ] || mkdir /opt #doh + [ -d /opt/rt3 ] || mkdir /opt/rt3 # + [ -d /opt/rt3/share ] || mkdir /opt/rt3/share # + cd rt; make install + rt/sbin/rt-setup-database --dba '${DB_USER}' \ + -dba-password '${DB_PASSWORD}' \ + -action schema \ + || true + rt/sbin/rt-setup-database --action insert_initial \ + && rt/sbin/rt-setup-database --action insert --datafile ${RT_PATH}/etc/initialdata \ + || true + +install-rt: + perl -p -i -e "\ + s'%%%RT_DOMAIN%%%'${RT_DOMAIN}'g;\ + s'%%%RT_TIMEZONE%%%'${RT_TIMEZONE}'g;\ + s'%%%FREESIDE_URL%%%'${FREESIDE_URL}'g;\ + " ${RT_PATH}/etc/RT_SiteConfig.pm + [ ${RT_ENABLED} -eq 1 ] && ( cd rt; make install ) || true + +clean: + rm -rf masondocs + rm -rf httemplate/docs/man + rm -rf pod2htmi.tmp + rm -rf pod2htmd.tmp + -cd FS; \ + make clean + -cd fs_selfservice/FS-SelfService; \ + make clean + +#these are probably only useful if you're me... + +#release: upload-docs +release: + cd /home/ivan/freeside + #cvs tag ${TAG} + cvs tag -F ${TAG} + + #cd /home/ivan + cvs export -r ${TAG} -d freeside-${VERSION} freeside + tar czvf freeside-${VERSION}.tar.gz freeside-${VERSION} + + scp freeside-${VERSION}.tar.gz ivan@420.am:/var/www/www.sisd.com/freeside/ + mv freeside-${VERSION} freeside-${VERSION}.tar.gz .. + +update-webdemo: + ssh ivan@420.am '( cd freeside; cvs update -d -P )' + #ssh root@420.am '( cd /home/ivan/freeside; make clean; make deploy )' + ssh root@420.am '( cd /home/ivan/freeside; make deploy )' + diff --git a/README b/README new file mode 100644 index 000000000..09484d26a --- /dev/null +++ b/README @@ -0,0 +1,54 @@ +Freeside + +Copyright (C) 2005-2008 Freeside Internet Services, Inc. +Copyright (C) 2000-2005 Ivan Kohler +Copyright (C) 1999 Silicon Interactive Software Design +Additional copyright holders may be found in the CREDITS file. +All rights reserved + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as published + by the Free Software Foundation, either version 3 of the License, or (at + your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public + License along with this program, in the file `AGPL'; if not, + see <http://www.fsf.org/licensing/licenses/agpl-3.0.html>. + + At your option, you may also redistribute and/or modify the files in the + fs_selfservice/ directory (but not the rest of the software) under the + terms of the GNU General Public License as published by the Free Software + Foundation, either version 3 of the License, or (at your option) any later + version. + + At your option, you may also redistribute and/or modify the + fs_selfservice/php/freeside.class.php file (but not the rest of the + software) under the terms of the GNU Lesser General Public License as + published by the Free Software Foundation, either version 3 of the License, + or (at your option) any later version. + +Freeside is a billing and administration package for Internet Service +Providers. + +The Freeside home page is at `http://www.freeside.biz/freeside'. + +The documentation is at `http://www.freeside.biz/mediawiki'. + +A mailing list for users is available. Send a blank message to +<freeside-users-subscribe@sisd.com> to subscribe. + +A mailing list for developers is available. It is intended to be lower volume +and higher SNR than the users list. Send a blank message to +<freeside-devel-subscribe@sisd.com> to subscribe. + +Commercial installation, customization and support services as well as +preconfigured appliances are available from Freeside Internet Services, Inc. +Contact us at: http://www.freeside.biz/freeside/contact.html + +Ivan Kohler <ivan-freeside_readme@420.am> + diff --git a/SCHEMA_CHANGE b/SCHEMA_CHANGE new file mode 100644 index 000000000..b3d77aaf8 --- /dev/null +++ b/SCHEMA_CHANGE @@ -0,0 +1,17 @@ +primarily: +- edit FS/FS/Schema.pm + +if the changes are something other than table and/or column additions: +- httemplate/docs/upgrade10.html +- README.1.7.X + +for new tables: +- make sure the new tables are added to FS/FS/Schema.pm and run make install-perl-modules +- run bin/generate-table-module tablename +- edit the resulting FS/FS/table.pm + +docs: +- sorta neglected: FS/FS.pm +- somehwat neglected: httemplate/docs/schema.html +- really neglected: httemplate/docs/schema.dia + diff --git a/TODO b/TODO new file mode 100644 index 000000000..c90fa165a --- /dev/null +++ b/TODO @@ -0,0 +1,7 @@ + +The TODO list / bug-tracking is temporarily unavailable. + +If you are interested in helping with development, please join the +*development* mailing list (send a blank message to +freeside-devel-subscribe@sisd.com) to avoid duplication of effort. + diff --git a/bin/add-history-records.pl b/bin/add-history-records.pl new file mode 100755 index 000000000..fbf9d09d9 --- /dev/null +++ b/bin/add-history-records.pl @@ -0,0 +1,139 @@ +#!/usr/bin/perl + +die "This is broken. Don't use it!\n"; + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearchs qsearch); + +use Data::Dumper; + +my @tables = qw(svc_acct svc_broadband svc_domain svc_external svc_forward svc_www cust_svc domain_record); +#my @tables = qw(svc_www); + +my $user = shift or die &usage; +my $dbh = adminsuidsetup($user); + +my $dbdef = FS::Record::dbdef; + +foreach my $table (@tables) { + + my $h_table = 'h_' . $table; + my $cnt = 0; + my $t_cnt = 0; + + eval "use FS::${table}"; + die $@ if $@; + eval "use FS::${h_table}"; + die $@ if $@; + + print "Adding history records for ${table}...\n"; + + my $dbdef_table = $dbdef->table($table); + my $pkey = $dbdef_table->primary_key; + + foreach my $rec (qsearch($table, {})) { + + #my $h_rec = qsearchs( + # $h_table, + # { $pkey => $rec->getfield($pkey) }, + # eval "FS::${h_table}->sql_h_searchs(time)", + #); + + my $h_rec = qsearchs( + $h_table, + { $pkey => $rec->getfield($pkey) }, + "DISTINCT ON ( $pkey ) *", + "AND history_action = 'insert' ORDER BY $pkey ASC, history_date DESC", + '', + 'AS maintable', + ); + + unless ($h_rec) { + my $h_insert_rec = $rec->_h_statement('insert', 1); + #print $h_insert_rec . "\n"; + $dbh->do($h_insert_rec); + die $dbh->errstr if $dbh->err; + $dbh->commit or die $dbh->errstr; + $cnt++; + } + + + $t_cnt++; + + } + + print "History records inserted into $h_table: $cnt\n"; + print " Total records in $table: $t_cnt\n"; + + print "\n"; + +} + +foreach my $table (@tables) { + + my $h_table = 'h_' . $table; + my $cnt = 0; + + eval "use FS::${table}"; + die $@ if $@; + eval "use FS::${h_table}"; + die $@ if $@; + + print "Adding insert records for unmatched delete records on ${table}...\n"; + + my $dbdef_table = $dbdef->table($table); + my $pkey = $dbdef_table->primary_key; + + #SELECT * FROM h_svc_www + #DISTINCT ON ( $pkey ) ? + my $where = " + WHERE ${pkey} in ( + SELECT ${h_table}1.${pkey} + FROM ${h_table} as ${h_table}1 + WHERE ( + SELECT count(${h_table}2.${pkey}) + FROM ${h_table} as ${h_table}2 + WHERE ${h_table}2.${pkey} = ${h_table}1.${pkey} + AND ${h_table}2.history_action = 'delete' + ) > 0 + AND ( + SELECT count(${h_table}3.${pkey}) + FROM ${h_table} as ${h_table}3 + WHERE ${h_table}3.${pkey} = ${h_table}1.${pkey} + AND ( ${h_table}3.history_action = 'insert' + OR ${h_table}3.history_action = 'replace_new' ) + ) = 0 + GROUP BY ${h_table}1.${pkey})"; + + + my @h_recs = qsearch( + $h_table, { }, + "DISTINCT ON ( $pkey ) *", + $where, + '', + '' + ); + + foreach my $h_rec (@h_recs) { + #print "Adding insert record for deleted record with pkey='" . $h_rec->getfield($pkey) . "'...\n"; + my $class = 'FS::' . $table; + my $rec = $class->new({ $h_rec->hash }); + my $h_insert_rec = $rec->_h_statement('insert', 1); + #print $h_insert_rec . "\n"; + $dbh->do($h_insert_rec); + die $dbh->errstr if $dbh->err; + $dbh->commit or die $dbh->errstr; + $cnt++; + } + + print "History records inserted into $h_table: $cnt\n"; + +} + + + +sub usage { + die "Usage:\n add-history-records.pl user\n"; +} + diff --git a/bin/all-postal-no-email b/bin/all-postal-no-email new file mode 100755 index 000000000..ef5dff66b --- /dev/null +++ b/bin/all-postal-no-email @@ -0,0 +1,22 @@ +#!/usr/bin/perl -w + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_main; + +my $user = shift or die &usage; +adminsuidsetup $user; + +foreach my $cust_main ( qsearch( 'cust_main', {} ) ) { + + print $cust_main->custnum. "\n"; + + $cust_main->invoicing_list( [ 'POST' ] ); + +} + +sub usage { + die "Usage:\n\n all-postal-no-email user\n"; +} + diff --git a/bin/apache.export b/bin/apache.export new file mode 100755 index 000000000..da2d73c1c --- /dev/null +++ b/bin/apache.export @@ -0,0 +1,93 @@ +#!/usr/bin/perl -w + +use strict; +use Getopt::Std; +#use File::Path; +use File::Rsync; +use Net::SSH qw(ssh); +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(qsearch qsearchs); +use FS::part_export; +use FS::cust_svc; +use FS::svc_www; + +use vars qw(%opt); +getopts("d", \%opt); + +my $user = shift or die &usage; +adminsuidsetup $user; + +#needs the export number in there somewhere too...? +my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/apache"; +mkdir $spooldir, 0700 unless -d $spooldir; + +my @exports = qsearch('part_export', { 'exporttype' => 'apache' } ); + +my $rsync = File::Rsync->new({ + rsh => 'ssh', +# dry_run => 1, +}); + +foreach my $export ( @exports ) { + + my $machine = $export->machine; + my $file = "$spooldir/$machine.conf"; + + warn "exporting apache configuration for $machine to $file\n" + if $opt{d}; + + open(HTTPD_CONF,">$file") or die "can't open $file: $!"; + + my $template = $export->option('template'); + + my @svc_www = $export->svc_x; + + foreach my $svc_www ( @svc_www ) { + use vars qw($zone $username $dir $email $config); + $zone = $svc_www->domain_record->zone; + $config = $svc_www->config; + if ( $svc_www->svc_acct ) { + $username = $svc_www->svc_acct->username; + $dir = $svc_www->svc_acct->dir; + $email = $svc_www->svc_acct->email; + } else { + $username = ''; + $dir = ''; + $email = ''; + } + + warn " adding configuration section for $zone\n" + if $opt{d}; + + print HTTPD_CONF eval(qq("$template")). "\n\n"; + } + + my $user = $export->option('user'); + my $httpd_conf = $export->option('httpd_conf'); + + warn "syncing $file to $httpd_conf on $machine\n" + if $opt{d}; + + $rsync->exec( { + src => $file, + dest => "$user\@$machine:$httpd_conf", + } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err); + # warn $rsync->out; + + my $restart = $export->option('restart') || 'apachectl graceful'; + + warn "running restart command $restart on $machine\n" + if $opt{d}; + + ssh("root\@$machine", $restart); + +} + +close HTTPD_CONF; + +# ----- + +sub usage { + die "Usage:\n apache.export [ -d ] user\n"; +} + diff --git a/bin/artera.import b/bin/artera.import new file mode 100644 index 000000000..716dddad0 --- /dev/null +++ b/bin/artera.import @@ -0,0 +1,75 @@ +#!/usr/bin/perl -w + +use strict; + +use Text::CSV_XS; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearchs); +use FS::svc_external; +use FS::svc_domain; +use FS::svc_acct; + +$FS::svc_Common::noexport_hack = 1; + +my $svcpart = 30; + +my $user = shift + or die 'Usage:\n\n artera.import user <artera_active_orders.csv'; +adminsuidsetup $user; + +## + +my $csv = new Text::CSV_XS; + +my $header = scalar(<>); + +my( $num, $linked ) = ( 0, 0 ); + +while (<>) { + my $status = $csv->parse($_) + or die $csv->error_input; + my($serial, $keycode, $name, $ordernum, $email) = $csv->fields(); + #warn join(" - ", $serial, $keycode, $name, $ordernum, $email ). "\n"; + + $email =~ /^([^@]+)\@([^@]+)$/ + or die $email; + my($username, $domain) = ( $1, $2 ); + my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ); + my $cust_svc = ''; + if ( $svc_domain ) { + my $svc_acct = qsearchs('svc_acct', { + 'username' => $username, + 'domsvc' => $svc_domain->svcnum, + } ); + $cust_svc = $svc_acct->cust_svc + if $svc_acct; + #} else { + # warn "can't find domain $domain\n"; + } + + my $exist = qsearchs('svc_external', { 'id' => $serial } ); + next if $exist; + + my $svc_external = new FS::svc_external { + 'svcpart' => $svcpart, + 'pkgnum' => ( $cust_svc ? $cust_svc->pkgnum : '' ), + 'id' => $serial, + 'title' => $keycode, + }; + #my $error = $svc_external->check; + my $error = $svc_external->insert; + if ( $cust_svc && $error =~ /^Already/ ) { + warn $error; + $svc_external->pkgnum(''); + $error = $svc_external->insert; + } + warn $error if $error; + + $num++; + $linked++ if $cust_svc; + #print "$num imported, $linked linked\n"; + +} + +print "$num imported, $linked linked\n"; + diff --git a/bin/backup-dvd b/bin/backup-dvd new file mode 100644 index 000000000..d0314b469 --- /dev/null +++ b/bin/backup-dvd @@ -0,0 +1,45 @@ +#!/bin/bash + +database="freeside" +DEVICE="/dev/hda" + +su freeside -c "pg_dump $database" >/var/backups/$database.sql + +DATE=$(date +%Y-%m-%d) + +#NOTE: These two paths must end in a / in +#order to correctly build up the other paths +#BACKUP_DIR="/backup/directory/" +BACKUP_DIR="/backup/" + #TEMP_BACKUP_FILES_DIR="/backup/temp/" + +BACKUP_FILE=$BACKUP_DIR"backup-"$DATE".tar.bz2" + #DATABASE_FILE=$TEMP_BACKUP_FILES_DIR"foo-"$DATE".sql" + + #These directories shouldn't end in a / although + #I don't think it will cause any problems if + #they do. There should be a space at the end though + #to ensure the database file gets concatenated correctly. + #SOURCE="/a/location /other/locations " $DATABASE_FILE + +#echo Removing old backup directories +rm -rf $BACKUP_DIR + #rm -rf $TEMP_BACKUP_FILES_DIR + +#echo Creating new backup directories +mkdir $BACKUP_DIR + #mkdir $TEMP_BACKUP_FILES_DIR + + #echo Creating database backup + #pg_dump -U username -f $DATABASE_FILE databaseName + +#echo Backing up $SOURCE to file $BACKUP_FILE +#tar -cvpl -f $BACKUP_FILE --anchored --exclude /backup / +tar -cjpl -f $BACKUP_FILE --anchored --exclude /backup / + + ##This is not necessary and possibly harmful for DVD+RW media + #echo Quick blanking media + #dvd+rw-format -blank /dev/hdc + +#echo Burning backup +growisofs -dvd-compat -Z $DEVICE -quiet -r -J $BACKUP_FILE diff --git a/bin/bill-as-nextmonth b/bin/bill-as-nextmonth new file mode 100755 index 000000000..813e84193 --- /dev/null +++ b/bin/bill-as-nextmonth @@ -0,0 +1,5 @@ +#!/bin/sh + +month=`date +%m` +nextmonth=`expr $month + 1` +/usr/local/bin/freeside-daily -d $nextmonth/1/`date +%Y` fs_daily diff --git a/bin/bill-as-nextmonth-BILL b/bin/bill-as-nextmonth-BILL new file mode 100755 index 000000000..91e943110 --- /dev/null +++ b/bin/bill-as-nextmonth-BILL @@ -0,0 +1,5 @@ +#!/bin/sh + +month=`date +%m` +nextmonth=`expr $month + 1` +/usr/local/bin/freeside-daily -d $nextmonth/1/`date +%Y` -p BILL fs_daily diff --git a/bin/bill-as-nextyear b/bin/bill-as-nextyear new file mode 100755 index 000000000..63c4ad2be --- /dev/null +++ b/bin/bill-as-nextyear @@ -0,0 +1,5 @@ +#!/bin/sh + +year=`date +%Y` +nextyear=`expr $year + 1` +/usr/local/bin/freeside-daily -d 1/1/$nextyear fs_daily diff --git a/bin/bill-as-nextyear-BILL b/bin/bill-as-nextyear-BILL new file mode 100755 index 000000000..0d77dd0d6 --- /dev/null +++ b/bin/bill-as-nextyear-BILL @@ -0,0 +1,5 @@ +#!/bin/sh + +year=`date +%Y` +nextyear=`expr $year + 1` +/usr/local/bin/freeside-daily -d 1/1/$nextyear -p BILL fs_daily diff --git a/bin/bill-for-nextmonth b/bin/bill-for-nextmonth new file mode 100755 index 000000000..e1a33764e --- /dev/null +++ b/bin/bill-for-nextmonth @@ -0,0 +1,5 @@ +#!/bin/sh + +month=`date +%m` +nextmonth=`expr $month + 1` +/usr/local/bin/freeside-daily -d $nextmonth/1/`date +%Y` -n fs_daily diff --git a/bin/bill-for-nextyear b/bin/bill-for-nextyear new file mode 100755 index 000000000..1430a5898 --- /dev/null +++ b/bin/bill-for-nextyear @@ -0,0 +1,5 @@ +#!/bin/sh + +year=`date +%Y` +nextyear=`expr $year + 1` +/usr/local/bin/freeside-daily -d 1/1/$nextyear -n fs_daily diff --git a/bin/bill-nextmonth b/bin/bill-nextmonth new file mode 100755 index 000000000..813e84193 --- /dev/null +++ b/bin/bill-nextmonth @@ -0,0 +1,5 @@ +#!/bin/sh + +month=`date +%m` +nextmonth=`expr $month + 1` +/usr/local/bin/freeside-daily -d $nextmonth/1/`date +%Y` fs_daily diff --git a/bin/bill-nextyear b/bin/bill-nextyear new file mode 100755 index 000000000..63c4ad2be --- /dev/null +++ b/bin/bill-nextyear @@ -0,0 +1,5 @@ +#!/bin/sh + +year=`date +%Y` +nextyear=`expr $year + 1` +/usr/local/bin/freeside-daily -d 1/1/$nextyear fs_daily diff --git a/bin/billco-upload b/bin/billco-upload new file mode 100644 index 000000000..ce4a43d5f --- /dev/null +++ b/bin/billco-upload @@ -0,0 +1,20 @@ +#!/bin/sh + +AGENTNUMS="1 2 3" + +date=`date +"%Y%m%d"` +dir="/usr/local/etc/freeside/export.DBI:Pg:dbname=freeside/cust_bill" +cd "$dir" + +for AGENTNUM in $AGENTNUMS; do + + for a in header detail; do + mv agentnum$AGENTNUM-$a.csv agentnum$AGENTNUM-$date-$a.csv + done + + zip agentnum$AGENTNUM-$date.zip agentnum$AGENTNUM-$date-header.csv agentnum$AGENTNUM-$date-detail.csv + + echo $dir/agentnum$AGENTNUM-$date.zip + +done + diff --git a/bin/bind.export b/bin/bind.export new file mode 100755 index 000000000..286e43a2d --- /dev/null +++ b/bin/bind.export @@ -0,0 +1,195 @@ +#!/usr/bin/perl -w + +use strict; +use File::Path; +use File::Rsync; +use Net::SSH qw(ssh); +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(qsearch qsearchs); +use FS::part_export; +use FS::cust_pkg; +use FS::cust_svc; +use FS::svc_domain; + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/bind"; +mkdir $spooldir, 0700 unless -d $spooldir; + +my @exports = qsearch('part_export', { 'exporttype' => 'bind' } ); +my @sexports = qsearch('part_export', { 'exporttype' => 'bind_slave' } ); + +my $rsync = File::Rsync->new({ + rsh => 'ssh', +# dry_run => 1, +}); + +foreach my $export ( @exports ) { + + my $machine = $export->machine; + my $prefix = "$spooldir/$machine"; + + my $bind_rel = $export->option('bind_release'); + my $ndc_cmd = $export->option('reload') + || ( ($bind_rel eq 'BIND9') ? 'rndc' : 'ndc' ); + my $minttl = $export->option('bind9_minttl'); + + #prevent old domain files from piling up + #rmtree "$prefix" or die "can't rmtree $prefix.db: $!"; + + mkdir $prefix, 0700 unless -d $prefix; + + open(NAMED_CONF,">$prefix/named.conf") + or die "can't open $prefix/named.conf: $!"; + + if ( -e "$prefix/named.conf.HEADER" ) { + open(CONF_HEADER,"<$prefix/named.conf.HEADER") + or die "can't open $prefix/named.conf.HEADER: $!"; + while (<CONF_HEADER>) { print NAMED_CONF $_; } + close CONF_HEADER; + } + + my $zonepath = $export->option('zonepath'); + $zonepath =~ s/\/$//; + + my @svc_domain = $export->svc_x; + + foreach my $svc_domain ( @svc_domain ) { + my $domain = $svc_domain->domain; + my @masters = qsearch('domain_record', { + 'svcnum' => $svc_domain->svcnum, + 'rectype' => '_mstr', + } ); + if ( @masters ) { + my $masters = join('; ', map { $_->recdata } @masters ); + + print NAMED_CONF <<END; +zone "$domain" { + type slave; + file "db.$domain"; + masters { $masters; }; +}; + +END + + } else { + + print NAMED_CONF <<END; +zone "$domain" { + type master; + file "$zonepath/db.$domain"; +}; + +END + + open (DB_MASTER,">$prefix/db.$domain") + or die "can't open $prefix/db.$domain: $!"; + + if ($bind_rel eq 'BIND9') { + print DB_MASTER "\$TTL $minttl\n\$ORIGIN $domain.\n"; + } + + my @domain_records = + qsearch('domain_record', { 'svcnum' => $svc_domain->svcnum } ); + foreach my $domain_record ( + sort { $b->rectype cmp $a->rectype } @domain_records + ) { + #if ( $domain_record->rectype eq 'SOA' ) { + # print DB_MASTER join("\t", $domain_record-> reczone + #} else { + print DB_MASTER join("\t", + map { $domain_record->getfield($_) } + qw( reczone recaf rectype recdata ) + ), "\n"; + #} + } + + close DB_MASTER; + + } + + } + + $rsync->exec( { + src => "$prefix/", + recursive => 1, + dest => "root\@$machine:$zonepath/", + exclude => [qw( *.import named.conf.HEADER named.conf )], + } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err); + # warn $rsync->out; + + $rsync->exec( { + src => "$prefix/named.conf", + dest => "root\@$machine:". $export->option('named_conf'), + } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err); +# warn $rsync->out; + + ssh("root\@$machine", "$ndc_cmd reload"); + +} + +close NAMED_CONF; + +foreach my $sexport ( @sexports ) { #false laziness with above + + my $machine = $sexport->machine; + my $prefix = "$spooldir/$machine"; + + my $bind_rel = $sexport->option('bind_release'); + my $ndc_cmd = ($bind_rel eq 'BIND9') ? 'rndc' : 'ndc'; + + #prevent old domain files from piling up + #rmtree "$prefix" or die "can't rmtree $prefix.db: $!"; + + mkdir $prefix, 0700 unless -d $prefix; + + open(NAMED_CONF,">$prefix/named.conf") + or die "can't open $prefix/named.conf: $!"; + + if ( -e "$prefix/named.conf.HEADER" ) { + open(CONF_HEADER,"<$prefix/named.conf.HEADER") + or die "can't open $prefix/named.conf.HEADER: $!"; + while (<CONF_HEADER>) { print NAMED_CONF $_; } + close CONF_HEADER; + } + + my $masters = $sexport->option('master'); + + #false laziness with freeside-sqlradius-reset + my @svc_domain = + map { qsearchs('svc_domain', { 'svcnum' => $_->svcnum } ) } + map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } + grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } + $sexport->export_svc; + + foreach my $svc_domain ( @svc_domain ) { + my $domain = $svc_domain->domain; + print NAMED_CONF <<END; +zone "$domain" { + type slave; + file "db.$domain"; + masters { $masters; }; +}; + +END + + } + + $rsync->exec( { + src => "$prefix/named.conf", + dest => "root\@$machine:". $sexport->option('named_conf'), + } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err); +# warn $rsync->out; + + ssh("root\@$machine", "$ndc_cmd reload"); + +} +close NAMED_CONF; + +# ----- + +sub usage { + die "Usage:\n bind.export user\n"; +} + diff --git a/bin/bind.import b/bin/bind.import new file mode 100755 index 000000000..1cdf5672c --- /dev/null +++ b/bin/bind.import @@ -0,0 +1,234 @@ +#!/usr/bin/perl -w +# +# REQUIRED: +# -p: part number for domains +# +# -n: named.conf file (or an include file with zones you want to import), +# for example root@ns.isp.com:/var/named/named.conf +# +# OPTIONAL: +# -d: dry-run, debug: don't insert any records, just dump debugging output +# -s: import slave zones as master. useful if you need to recreate your +# primary nameserver from a secondary +# -c dir: override patch for downloading zone files (for example, when +# downloading zone files from chrooted bind) +# +# need to manually put header in +# /usr/local/etc/freeside/export.<datasrc./bind/<machine>/named.conf.HEADER +# (or, nowadays, better just to include the file freeside exports) + +use strict; + +use vars qw($domain_svcpart); + +use Getopt::Std; +use Data::Dumper; +#use BIND::Conf_Parser; +#use DNS::ZoneParse 0.81; + +use Net::SCP qw(scp iscp); + +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(qsearch); #qsearchs); +#use FS::svc_acct_sm; +use FS::svc_domain; +use FS::domain_record; +#use FS::svc_acct; +#use FS::part_svc; + +use vars qw($opt_p $opt_n $opt_s $opt_c $opt_d); +getopts("p:n:sc:d"); + +my $user = shift or die &usage; +adminsuidsetup $user; + +$FS::svc_Common::noexport_hack = 1; +$FS::domain_record::noserial_hack = 1; + +use vars qw($spooldir); +$spooldir = "/usr/local/etc/freeside/export.". datasrc. "/bind"; +mkdir $spooldir unless -d $spooldir; + +$domain_svcpart = $opt_p; + +my $named_conf = $opt_n; + +use vars qw($named_machine $prefix); +$named_machine = (split(/:/, $named_conf))[0]; +my $pnamed_machine = $named_machine; +$pnamed_machine =~ s/^[\w\-]+\@//; +$prefix = "$spooldir/$pnamed_machine"; +mkdir $prefix unless -d $prefix; + +#iscp("$named_conf","$prefix/named.conf.import"); +scp("$named_conf","$prefix/named.conf.import"); + +## + +$FS::svc_domain::whois_hack=1; + +my $p = Parser->new; +$p->parse_file("$prefix/named.conf.import"); + +print "\nBIND import completed.\n"; + +## + +sub usage { + die "Usage:\n\n bind.import -p partnum -n \"user\@machine:/path/to/named.conf\" [ -s ] [ -c chroot_dir ] [ -f ] user\n"; +} + +######## +BEGIN { + + package Parser; + use BIND::Conf_Parser; + use vars qw(@ISA $named_dir); + @ISA = qw(BIND::Conf_Parser); + + $named_dir = 'COULD_NOT_FIND_NAMED_DIRECTORY_TRY_SETTING_-C_OPTION'; + sub handle_option { + my($self, $option, $argument) = @_; + return unless $option eq "directory"; + $named_dir = $argument; + #warn "found named dir: $named_dir\n"; + } + + sub handle_zone { + my($self, $name, $class, $type, $options) = @_; + return unless $class eq 'in'; + return if grep { $name eq $_ } (qw( + . localhost 127.in-addr.arpa 0.in-addr.arpa 255.in-addr.arpa + 0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa + 0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.int + )); + + use FS::Record qw(qsearchs); + use FS::svc_domain; + + my $domain = + qsearchs('svc_domain', { 'domain' => $name } ) + || new FS::svc_domain( { + svcpart => $main::domain_svcpart, + domain => $name, + action => 'N', + } ); + unless ( $domain->svcnum ) { + my $error = $domain->insert; + die $error if $error; + } + + if ( $type eq 'slave' && !$main::opt_s ) { + + if ( $main::opt_d ) { + + use Data::Dumper; + print "$name: ". Dumper($options); + + } else { + + foreach my $master ( @{ $options->{masters} } ) { + my $domain_record = new FS::domain_record( { + 'svcnum' => $domain->svcnum, + 'reczone' => '@', + 'recaf' => 'IN', + 'rectype' => '_mstr', + 'recdata' => $master, + } ); + my $error = $domain_record->insert; + die $error if $error; + } + + } + + } elsif ( $type eq 'master' || ( $type eq 'slave' && $main::opt_s ) ) { + + my $file = $options->{file}; + + use File::Basename; + my $basefile = basename($file); + my $sourcefile = $file; + if ( $main::opt_c ) { + $sourcefile = "$main::opt_c/$sourcefile" if $main::opt_c; + } else { + $sourcefile = "$named_dir/$sourcefile" unless $file =~ /^\//; + } + + use Net::SCP qw(iscp scp); + #iscp("$main::named_machine:$sourcefile", + # "$main::prefix/$basefile.import"); + scp("$main::named_machine:$sourcefile", + "$main::prefix/$basefile.import"); + + use DNS::ZoneParse 0.84; + my $zone = DNS::ZoneParse->new("$main::prefix/$basefile.import"); + + my $dump = $zone->dump; + + if ( $main::opt_d ) { + + use Data::Dumper; + print "$name: ". Dumper($dump); + + } else { + + foreach my $rectype ( keys %$dump ) { + if ( $rectype =~ /^SOA$/i ) { + my $rec = $dump->{$rectype}; + $rec->{email} =~ s/\@/\./; + my $domain_record = new FS::domain_record( { + 'svcnum' => $domain->svcnum, + 'reczone' => $rec->{origin}, + 'recaf' => 'IN', + 'rectype' => $rectype, + 'recdata' => + $rec->{primary}. ' '. $rec->{email}. ' ( '. + join(' ', map $rec->{$_}, + qw( serial refresh retry expire minimumTTL ) ). + ' )', + } ); + my $error = $domain_record->insert; + die $error if $error; + } else { + #die $dump->{$rectype}; + + my $datasub; + if ( $rectype =~ /^MX$/i ) { + $datasub = sub { $_[0]->{priority}. ' '. $_[0]->{host}; }; + } elsif ( $rectype =~ /^TXT$/i ) { + $datasub = sub { $_[0]->{text}; }; + } else { + $datasub = sub { $_[0]->{host}; }; + } + + foreach my $rec ( @{ $dump->{$rectype} } ) { + my $domain_record = new FS::domain_record( { + 'svcnum' => $domain->svcnum, + 'reczone' => $rec->{name}, + 'recaf' => $rec->{class} || 'IN', + 'rectype' => $rectype, + 'recdata' => &{$datasub}($rec), + } ); + my $error = $domain_record->insert; + if ( $error ) { + warn "$error inserting ". + $rec->{name}. ' . '. $domain->domain. "\n"; + warn Dumper($rec); + #system('cat',"$main::prefix/$basefile.import"); + die; + } + } + } + } + + } + + #} else { + # die "unrecognized type $type\n"; + } + + } + +} +######### + diff --git a/bin/breakdown-bill-applications b/bin/breakdown-bill-applications new file mode 100644 index 000000000..44c3e36b0 --- /dev/null +++ b/bin/breakdown-bill-applications @@ -0,0 +1,25 @@ +#!/usr/bin/perl -w + +use strict; +use FS::UID qw(adminsuidsetup dbh); +use FS::Record qw( qsearch ); +use FS::cust_bill_pay; +use FS::cust_credit_bill; + +$FS::CurrentUser::upgrade_hack = 1; +adminsuidsetup(shift) or die "Usage: breakdown-bill-applications username\n"; + +#quick and dirty conversion script if you have enough memory to throw at it + +my @tables = qw( cust_bill_pay cust_credit_bill ); + +my @apps = (); +foreach my $table { + push @apps, qsearch($table, + + +) { + +} + +foreach my $cust_bill_ diff --git a/bin/bsdshell.export b/bin/bsdshell.export new file mode 100755 index 000000000..6e0d1037e --- /dev/null +++ b/bin/bsdshell.export @@ -0,0 +1,114 @@ +#!/usr/bin/perl -w + +# bsdshell export + +use strict; +use File::Rsync; +use Net::SSH qw(ssh); +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(qsearch qsearchs); +use FS::part_export; +use FS::cust_svc; +use FS::svc_acct; + +my @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $spooldir = "/usr/local/etc/freeside/export.". datasrc; +#my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/shell"; + +my @bsd_exports = qsearch('part_export', { 'exporttype' => 'bsdshell' } ); + +my $rsync = File::Rsync->new({ + rsh => 'ssh', +# dry_run => 1, +}); + +foreach my $export ( @bsd_exports ) { + my $machine = $export->machine; + my $prefix = "$spooldir/$machine"; + mkdir $prefix, 0700 unless -d $prefix; + + #LOCKING!!! + + ( open(MASTER,">$prefix/master.passwd") + #!!! and flock(MASTER,LOCK_EX|LOCK_NB) + ) or die "Can't open $prefix/master.passwd: $!"; + ( open(PASSWD,">$prefix/passwd") + #!!! and flock(PASSWD,LOCK_EX|LOCK_NB) + ) or die "Can't open $prefix/passwd: $!"; + + chmod 0644, "$prefix/passwd"; + chmod 0600, "$prefix/master.passwd"; + + my @svc_acct = $export->svc_x; + + next unless @svc_acct; + + foreach my $svc_acct ( sort { $a->uid <=> $b->uid } @svc_acct ) { + + my $password = $svc_acct->_password; + my $cpassword; + #if ( ( length($password) <= 8 ) + if ( ( length($password) <= 12 ) + && ( $password ne '*' ) + && ( $password ne '!!' ) + && ( $password ne '' ) + ) { + $cpassword=crypt($password, + $saltset[int(rand(64))].$saltset[int(rand(64))] + ); + # MD5 !!!! + } else { + $cpassword=$password; + } + + ### + # FORMAT OF THE PASSWD FILE HERE + print PASSWD join(":", + $svc_acct->username, + 'x', # "##". $username, + $svc_acct->uid, + $svc_acct->gid, + $svc_acct->finger, + $svc_acct->dir, + $svc_acct->shell, + ), "\n"; + + ### + # FORMAT OF FreeBSD MASTER PASSWD FILE HERE + print MASTER join(":", + $svc_acct->username, # User name + $cpassword, # Encrypted password + $svc_acct->uid, # User ID + $svc_acct->gid, # Group ID + "", # Login Class + "0", # Password Change Time + "0", # Password Expiration Time + $svc_acct->finger, # Users name + $svc_acct->dir, # Users home directory + $svc_acct->shell, # shell + ), "\n" ; + + } + + #!!! flock(MASTER,LOCK_UN); + #!!! flock(PASSWD,LOCK_UN); + close MASTER; + close PASSWD; + + $rsync->exec( { + src => "$prefix/passwd", + dest => "root\@$machine:/etc/passwd" + } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err); + + $rsync->exec( { + src => "$prefix/master.passwd", + dest => "root\@$machine:/etc/master.passwd.new" + } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err); + ssh("root\@$machine", "pwd_mkdb /etc/master.passwd.new"); + + # UNLOCK!! +} diff --git a/bin/cdr_calltype.import b/bin/cdr_calltype.import new file mode 100755 index 000000000..a998284f6 --- /dev/null +++ b/bin/cdr_calltype.import @@ -0,0 +1,41 @@ +#!/usr/bin/perl -w +# +# bin/cdr_calltype.import ivan ~ivan/convergent/newspecs/fixed_inbound/calltypes.csv + +use strict; +use FS::UID qw(dbh adminsuidsetup); +use FS::cdr_calltype; + +my $user = shift or die &usage; +adminsuidsetup $user; + +while (<>) { + + chomp; + my $line = $_; + + #$line =~ /^(\d+),"([^"]+)"$/ or do { + $line =~ /^(\d+),"([^"]+)"/ or do { + warn "unparsable line: $line\n"; + next; + }; + + my $cdr_calltype = new FS::cdr_calltype { + 'calltypenum' => $1, + 'calltypename' => $2, + }; + + #my $error = $cdr_calltype->check; + my $error = $cdr_calltype->insert; + if ( $error ) { + warn "********** $error FOR LINE: $line\n"; + dbh->commit; + #my $wait = scalar(<STDIN>); + } + +} + +sub usage { + "Usage:\n\ncdr_calltype.import username filename ...\n"; +} + diff --git a/bin/cdr_upstream_rate.import b/bin/cdr_upstream_rate.import new file mode 100755 index 000000000..fda3883b5 --- /dev/null +++ b/bin/cdr_upstream_rate.import @@ -0,0 +1,142 @@ +#!/usr/bin/perl -w +# +# Usage: bin/cdr_upstream_rate.import username ratenum filename +# +# records will be imported into cdr_upstream_rate, rate_detail and rate_region +# +# Example: bin/cdr_upstream_rate.import ivan 1 ~ivan/convergent/sample_rate_table.csv +# +# username: a freeside login (from /usr/local/etc/freeside/mapsecrets) +# ratenum: rate plan (FS::rate) created with the web UI +# filename: CSV file +# +# the following fields are currently used: +# - Class Code => cdr_upstream_rate.rateid +# - Description => rate_region.regionname +# (rate_detail->dest_region) +# - 1_rate => ( * 60 / 1_rate_seconds ) => rate_detail.min_charge +# - 1_rate_seconds => (used above) +# - 1_second_increment => rate_detail.sec_granularity +# +# the following fields are not (yet) used: +# - Flagfall => what's this for? +# +# - 1_cap_time => freeside doesn't have voip time caps yet... +# - 1_cap_cost => freeside doesn't have voip cost caps yet... +# - 1_repeat => not sure what this is for, sample data is all 0 +# +# - 2_rate => \ +# - 2_rate_seconds => | +# - 2_second_increment => | not sure what the second set of rate data +# - 2_cap_time => | is supposed to be for... +# - 2_cap_cost => | +# - 2_repeat => / +# +# - Carrier => probably not needed? +# - Start Date => not necessary? + +use strict; +use vars qw( $DEBUG ); +use Text::CSV_XS; +use FS::UID qw(dbh adminsuidsetup); +use FS::Record qw(qsearchs); +use FS::rate; +use FS::cdr_upstream_rate; +use FS::rate_detail; +use FS::rate_region; + +$DEBUG = 1; + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $ratenum = shift or die &usage; + +my $rate = qsearchs( 'rate', { 'ratenum' => $ratenum } ); +die "rate plan $ratenum not found in rate table\n" + unless $rate; + +my $csv = new Text::CSV_XS; +my $hline = scalar(<>); +chomp($hline); +$csv->parse($hline) or die "can't parse header: $hline\n"; +my @header = $csv->fields(); + +$FS::UID::AutoCommit = 0; + +while (<>) { + + chomp; + my $line = $_; + +# #$line =~ /^(\d+),"([^"]+)"$/ or do { +# #} +# $line =~ /^(\d+),"([^"]+)"/ or do { +# warn "unparsable line: $line\n"; +# next; +# }; + + $csv->parse($line) or die "can't parse line: $line\n"; + my @line = $csv->fields(); + + my %hash = map { $_ => shift(@line) } @header; + + warn join('', map { "$_ => $hash{$_}\n" } keys %hash ) + if $DEBUG > 1; + + my $rate_region = new FS::rate_region { + 'regionname' => $hash{'Description'} + }; + + my $error = $rate_region->insert; + if ( $error ) { + dbh->rollback; + die "error inserting into rate_region: $error\n"; + } + my $dest_regionnum = $rate_region->regionnum; + warn "rate_region $dest_regionnum inserted\n" + if $DEBUG; + + my $rate_detail = new FS::rate_detail { + 'ratenum' => $ratenum, + 'dest_regionnum' => $dest_regionnum, + 'min_included' => 0, + #'min_charge', => sprintf('%.5f', 60 * $hash{'1_rate'} / $hash{'1_rate_seconds'} ), + 'min_charge', => sprintf('%.5f', $hash{'1_rate'} / + ( $hash{'1_rate_seconds'} / 60 ) + ), + 'sec_granularity' => $hash{'1_second_increment'}, + }; + $error = $rate_detail->insert; + if ( $error ) { + dbh->rollback; + die "error inserting into rate_detail: $error\n"; + } + my $ratedetailnum = $rate_detail->ratedetailnum; + warn "rate_detail $ratedetailnum inserted\n" + if $DEBUG; + + my $cdr_upstream_rate = new FS::cdr_upstream_rate { + 'upstream_rateid' => $hash{'Class Code'}, + 'ratedetailnum' => $rate_detail->ratedetailnum, + }; + $error = $cdr_upstream_rate->insert; + if ( $error ) { + dbh->rollback; + die "error inserting into cdr_upstream_rate: $error\n"; + } + warn "cdr_upstream_rate ". $cdr_upstream_rate->upstreamratenum. " inserted\n" + if $DEBUG; + + dbh->commit or die "can't commit: ". dbh->errstr; + + warn "\n" if $DEBUG; + +} + +dbh->commit or die "can't commit: ". dbh->errstr; + +sub usage { + "Usage:\n\ncdr_upstream_rate.import username ratenum filename\n"; +} + diff --git a/bin/create-fetchmailrc b/bin/create-fetchmailrc new file mode 100644 index 000000000..11bde0ce3 --- /dev/null +++ b/bin/create-fetchmailrc @@ -0,0 +1,47 @@ +#!/usr/bin/perl -w +# this quick hack helps you generate/maintain .fetchmailrc files from +# FS::acct_snarf data. it is run from a shellcommands export as: +# create-fetchmailrc $username $dir $snarf_machine1 $snarf_username1 $snarf__password1 $snarf_machine2 $snarf_username2 $snarf__password2 ... + +use strict; +use POSIX qw( setuid setgid ); + +my $header = <<END; +# Configuration created by create-fetchmailrc +set postmaster "postmaster" +set bouncemail +set no spambounce +set properties "" +set daemon 240 +END + +my $username = shift @ARGV or die "no username specified\n"; +my $homedir = shift @ARGV or die "no homedir specified\n"; +my $filename = "$homedir/.fetchmailrc"; + +my $gid = scalar(getgrnam($username)) or die "can't find $username's gid\n"; +my $uid = scalar(getpwnam($username)) or die "can't find $username's uid\n"; + +exit unless $ARGV[0]; + +open(FETCHMAILRC, ">$filename") or die "can't open $filename: $!\n"; +chown $uid, $gid, $filename or die "can't chown $uid.$gid $filename: $!\n"; +chmod 0600, $filename or die "can't chmod 600 $filename: $!\n"; +print FETCHMAILRC $header; + +while ($ARGV[0]) { + my( $s_machine, $s_username, $s_password ) = splice( @ARGV, 0, 3 ); + print FETCHMAILRC <<END; +poll $s_machine + user '$s_username' there with password '$s_password' is '$username' here +END +} + +close FETCHMAILRC; + +setgid($gid) or die "can't setgid $gid\n"; +setuid($uid) or die "can't setuid $uid\n"; +$ENV{HOME} = $homedir; + +system(qq(fetchmail -a -K --antispam "550,451" -d 180 -f $filename)); + diff --git a/bin/customer-faker b/bin/customer-faker new file mode 100755 index 000000000..d57e5e1de --- /dev/null +++ b/bin/customer-faker @@ -0,0 +1,122 @@ +#!/usr/bin/perl + +use strict; +use Getopt::Std; +use Data::Faker; +use Business::CreditCard; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_main; +use FS::cust_pkg; +use FS::svc_acct; + +my $agentnum = 1; +my $refnum = 1; + +my @pkgs = ( 2, 3, 4 ); +#my @pkgs = ( 4, 5, 6 ); +my $svcpart = 2; + +use vars qw( $opt_p ); +getopts('p:'); + +my $user = shift or die &usage; +my $num = shift or die &usage; +adminsuidsetup($user); + +my $onum = $num; +my $start = time; + +my @states = qw( AL AK AS AZ AR CA CO CT DE DC FL GA GU HI ID IL IN IA KS KY LA ME MD MA MI MN MS MO MT NE NV NH NJ NM NY NC ND MP OH OK OR PA PR RI SC SD TN TX UT VT VI VA WA WV WI WY ); +#FM MH + +until ( $num-- <= 0 ) { + + my $faker = new Data::Faker; + + my $cust_main = new FS::cust_main { + 'agentnum' => $agentnum, + 'refnum' => $refnum, + 'first' => $faker->first_name, + 'last' => $faker->last_name, + 'company' => ( $num % 2 ? $faker->company. ', '. $faker->company_suffix : '' ), #half with companies.. + 'address1' => $faker->street_address, + 'city' => 'Tofutown', #missing, so everyone is from tofutown# $faker->city, + #'state' => $faker->us_state_abbr, + 'state' => $states[ int(rand($#states)) ], + 'zip' => $faker->us_zip_code, + 'country' => 'US', + 'daytime' => $faker->phone_number, + 'night' => $faker->phone_number, + #forget it, these can have extensions# 'fax' => ( $num % 2 ? $faker->phone_number : '' ), #ditto + #bah, forget shipping addresses + 'payby' => 'BILL', + 'payip' => $faker->ip_address, + }; + + if ( $opt_p eq 'CARD' || ( !$opt_p && rand() > .33 ) ) { + $cust_main->payby('CARD'); + my $cardnum = '4123'. sprintf('%011u', int(rand(100000000000)) ); + $cust_main->payinfo( $cardnum. generate_last_digit($cardnum) ); + $cust_main->paydate( '2009-05-01' ); + } elsif ( $opt_p eq 'CHEK' || ( !$opt_p && rand() > .66 ) ) { + $cust_main->payby('CHEK'); + my $payinfo = sprintf('%7u@%09u', int(rand(10000000)), int(rand(1000000000)) ); + $cust_main->payinfo($payinfo); + $cust_main->payname( 'First International Bank of Testing' ); + } + + # could insert invoicing_list and other stuff too.. hell, could insert + # packages, services, more + # but i just wanted 10k customers to test the pager and this was good enough + # not anymore, here's some services and packages + + my $now = time; + my $year = 31556736; #60*60*24*365.24 + my $setup = $now - int(rand($year)); + + my $cust_pkg = new FS::cust_pkg { + 'pkgpart' => $pkgs[ int(rand(scalar(@pkgs))) ], + + #some dates in here would be nice + 'setup' => $setup, + #'last_bill' + #'bill' + #'susp' + #'expire' + #'cancel' + }; + + my $svc_acct = new FS::svc_acct { + 'svcpart' => $svcpart, + 'username' => $faker->username, + }; + + while ( qsearch( 'svc_acct', { 'username' => $svc_acct->username } ) ) { + my $username = $svc_acct->username; + $username++; + $svc_acct->username($username); + } + + use Tie::RefHash; + tie my %hash, 'Tie::RefHash', + $cust_pkg => [ $svc_acct ], + ; + + my $error = $cust_main->insert( \%hash ); + die $error if $error; + +} + +my $end = time; + +my $sec = $end-$start; +$sec=1 if $sec==0; +my $persec = $onum / $sec; +print "$onum customers inserted in $sec seconds ($persec customers/sec)\n"; + +#--- + +sub usage { + die "Usage:\n\n customer-faker [ -p payby ] user num_fakes\n"; +} diff --git a/bin/expand-country b/bin/expand-country new file mode 100755 index 000000000..c6f2a1f09 --- /dev/null +++ b/bin/expand-country @@ -0,0 +1,29 @@ +#!/usr/bin/perl -w + +use strict; +use Locale::SubCountry; +use FS::UID qw(adminsuidsetup); +use FS::Setup; +use FS::Record qw(qsearch); +use FS::cust_main_county; + +my $user = shift or die &usage; +my $country = shift or die &usage; + +adminsuidsetup($user); + +my @country = qsearch('cust_main_county', { 'country' => $country } ); +die "unknown country $country" unless (@country); +#die "$country already expanded" if scalar(@country) > 1; + +foreach my $cust_main_county ( @country ) { + my $error = $cust_main_county->delete; + die $error if $error; +} + +FS::Setup::_add_country($country); + +sub usage { + die "Usage:\n\n expand-country user countrycode\n"; +} + diff --git a/bin/explain-ar-total.sql b/bin/explain-ar-total.sql new file mode 100644 index 000000000..f1544303b --- /dev/null +++ b/bin/explain-ar-total.sql @@ -0,0 +1,976 @@ +EXPLAIN SELECT ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill LEFT JOIN cust_main USING ( custnum ) WHERE cust_bill._date > ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund LEFT JOIN cust_main USING ( custnum ) WHERE cust_refund._date > ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit LEFT JOIN cust_main USING ( custnum ) WHERE cust_credit._date > ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay LEFT JOIN cust_main USING ( custnum ) WHERE cust_pay._date > ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + AS balance_0_30, ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill LEFT JOIN cust_main USING ( custnum ) WHERE cust_bill._date <= ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND cust_bill._date > ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund LEFT JOIN cust_main USING ( custnum ) WHERE cust_refund._date <= ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND cust_refund._date > ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit LEFT JOIN cust_main USING ( custnum ) WHERE cust_credit._date <= ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND cust_credit._date > ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay LEFT JOIN cust_main USING ( custnum ) WHERE cust_pay._date <= ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND cust_pay._date > ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + AS balance_30_60, ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill LEFT JOIN cust_main USING ( custnum ) WHERE cust_bill._date <= ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND cust_bill._date > ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund LEFT JOIN cust_main USING ( custnum ) WHERE cust_refund._date <= ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND cust_refund._date > ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit LEFT JOIN cust_main USING ( custnum ) WHERE cust_credit._date <= ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND cust_credit._date > ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay LEFT JOIN cust_main USING ( custnum ) WHERE cust_pay._date <= ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND cust_pay._date > ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + AS balance_60_90, ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill LEFT JOIN cust_main USING ( custnum ) WHERE cust_bill._date <= ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund LEFT JOIN cust_main USING ( custnum ) WHERE cust_refund._date <= ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit LEFT JOIN cust_main USING ( custnum ) WHERE cust_credit._date <= ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay LEFT JOIN cust_main USING ( custnum ) WHERE cust_pay._date <= ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + AS balance_90_0, ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill LEFT JOIN cust_main USING ( custnum ) WHERE ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund LEFT JOIN cust_main USING ( custnum ) WHERE ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit LEFT JOIN cust_main USING ( custnum ) WHERE ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay LEFT JOIN cust_main USING ( custnum ) WHERE ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + AS balance_0_0 diff --git a/bin/find-overapplied b/bin/find-overapplied new file mode 100644 index 000000000..7973cef5b --- /dev/null +++ b/bin/find-overapplied @@ -0,0 +1,27 @@ +#!/usr/bin/perl -w + +use strict; +use Data::Dumper; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_credit; +use FS::cust_pay; + +my $user = shift or die &usage; +adminsuidsetup $user; + +my @credits = grep { $_->credited < 0 } qsearch('cust_credit', {}); +my @payments = grep { $_->unapplied < 0 } qsearch('cust_pay', {}); + +if ( @credits ) { + print scalar(@credits). " overapplied credits:\n". Dumper(@credits). "\n"; +} + +if ( @payments ) { + print scalar(@payments). " overapplied payments:\n". Dumper(@payments). "\n"; +} + +sub usage { + die "Usage:\n\n find-overapplied user\n"; +} + diff --git a/bin/fix-sequences b/bin/fix-sequences new file mode 100755 index 000000000..dc4abd751 --- /dev/null +++ b/bin/fix-sequences @@ -0,0 +1,69 @@ +#!/usr/bin/perl -Tw + +# run dbdef-create first! + +use strict; +use DBI; +use DBIx::DBSchema 0.26; +use DBIx::DBSchema::Table; +use DBIx::DBSchema::Column; +use DBIx::DBSchema::ColGroup::Unique; +use DBIx::DBSchema::ColGroup::Index; +use FS::UID qw(adminsuidsetup driver_name); +use FS::Record qw(dbdef); + +my $user = shift or die &usage; +my $dbh = adminsuidsetup $user; + +my $schema = dbdef(); + +#false laziness w/fs-setup +my @tables = scalar(@ARGV) + ? @ARGV + : grep { ! /^h_/ } $schema->tables; +foreach my $table ( @tables ) { + my $tableobj = $schema->table($table) + or die "unknown table $table (did you run dbdef-create?)\n"; + + my $primary_key = $tableobj->primary_key; + next unless $primary_key; + + my $col = $tableobj->column($primary_key); + + + next unless uc($col->type) eq 'SERIAL' + || ( driver_name eq 'Pg' + && defined($col->default) + && $col->default =~ /^nextval\(/i + ) + || ( driver_name eq 'mysql' + && defined($col->local) + && $col->local =~ /AUTO_INCREMENT/i + ); + + my $seq = "${table}_${primary_key}_seq"; + if ( driver_name eq 'Pg' + && defined($col->default) + && $col->default =~ /^nextval\('"(public\.)?(\w+_seq)"'::text\)$/ + ) { + $seq = $2; + } + + warn "fixing sequence for $table\n"; + + + my $sql = "SELECT setval( '$seq', + ( SELECT max($primary_key) FROM $table ) );"; + + #warn $col->default. " $seq\n$sql\n"; + $dbh->do( $sql ) or die $dbh->errstr; + +} + +$dbh->commit or die $dbh->errstr; +$dbh->disconnect or die $dbh->errstr; + +sub usage { + die "Usage:\n fix-sequences user [ table table ... ] \n"; +} + diff --git a/bin/freeside-init b/bin/freeside-init new file mode 100755 index 000000000..fe12931fc --- /dev/null +++ b/bin/freeside-init @@ -0,0 +1,60 @@ +#! /bin/sh +# +# start the freeside job queue daemon + +#PATH=/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin +DAEMON=/usr/local/bin/freeside-queued +NAME=freeside-queued +DESC="freeside job queue daemon" +USER="ivan" + +test -f $DAEMON || exit 0 + +set -e + +case "$1" in + start) + echo -n "Starting $DESC: " +# start-stop-daemon --start --quiet --pidfile /var/run/$NAME.pid -b -m\ +# --exec $DAEMON + $DAEMON $USER & + echo "$NAME." + ;; + stop) + echo -n "Stopping $DESC: " + start-stop-daemon --stop --quiet --pidfile /var/run/$NAME.pid \ + --exec $DAEMON + echo "$NAME." + rm /var/run/$NAME.pid + ;; + #reload) + # + # If the daemon can reload its config files on the fly + # for example by sending it SIGHUP, do it here. + # + # If the daemon responds to changes in its config file + # directly anyway, make this a do-nothing entry. + # + # echo "Reloading $DESC configuration files." + # start-stop-daemon --stop --signal 1 --quiet --pidfile \ + # /var/run/$NAME.pid --exec $DAEMON + #;; + restart|force-reload) + # + # If the "reload" option is implemented, move the "force-reload" + # option to the "reload" entry above. If not, "force-reload" is + # just the same as "restart". + # + $0 stop + sleep 1 + $0 start + ;; + *) + N=/etc/init.d/$NAME + # echo "Usage: $N {start|stop|restart|reload|force-reload}" >&2 + echo "Usage: $N {start|stop|restart|force-reload}" >&2 + exit 1 + ;; +esac + +exit 0 diff --git a/bin/freeside-migrate-events b/bin/freeside-migrate-events new file mode 100644 index 000000000..76643b886 --- /dev/null +++ b/bin/freeside-migrate-events @@ -0,0 +1,229 @@ +#!/usr/bin/perl -w + +use strict; + +use FS::UID qw(adminsuidsetup); +use FS::Record qw( qsearch ); +use FS::part_bill_event; +use FS::part_event; +use FS::cust_bill_event; +use FS::cust_event; + +my $user = shift or die &usage; +adminsuidsetup($user); + +my %plan2action = ( + 'fee' => 'fee', + 'fee_percent' => 'NOTYET', #XXX need fee_percent action + 'suspend' => 'suspend', + 'suspend-if-balance' => 'NOTYET', #XXX "if balance" becomes a balance condition + 'suspend-if-pkgpart' => 'suspend_if_pkgpart', + 'suspend-unless-pkgpart' => 'suspend_unless_pkgpart', + 'cancel' => 'cancel', + 'addpost' => 'addpost', + 'comp' => 'NOTYET', #XXX or N/A or something + 'credit' => 'NOTYET', + 'realtime-card' => 'cust_bill_realtime_card', + 'realtime-check' => 'cust_bill_realtime_check', + 'realtime-lec' => 'cust_bill_realtime_lec', + 'batch-card' => 'cust_bill_batch', + #?'retriable' => + 'send' => 'cust_bill_send', + 'send_email' => 'NOTYET', + 'send_alternate' => 'cust_bill_send_alternate', + 'send_if_newest' => 'cust_bill_send_if_newest', + 'send_agent' => 'cust_bill_send_agent', + 'send_csv_ftp' => 'cust_bill_send_csv_ftp', + 'spool_csv', => 'cust_bill_spool_csv', + 'bill' => 'bill', + 'apply' => 'apply', + 'collect' => 'collect', +); + + +foreach my $part_bill_event ( + qsearch({ + 'table' => 'part_bill_event', + }) +) { + + print $part_bill_event->event; + + my $action = $plan2action{ $part_bill_event->plan }; + + if ( $action eq 'NOTYET' ) { + warn "not migrating part_bill_event.eventpart ".$part_bill_event->eventpart. + "; ". $part_bill_event->plan. " plan not (yet) handled"; + next; + } elsif ( ! $action ) { + warn "not migrating part_bill_event.eventpart ".$part_bill_event->eventpart. + "; unknown plan ". $part_bill_event->plan; + next; + } + + my %plandata = map { /^(\w+) (.*)$/; ($1, $2); } + split(/\n/, $part_bill_event->plandata); + + #XXX may need to fudge some plandata2option names!!! + + my $part_event = new FS::part_event { + 'event' => $part_bill_event->event, + 'eventtable' => 'cust_bill', + 'check_freq' => $part_bill_event->freq || '1d', + 'weight' => $part_bill_event->weight, + 'action' => $action, + 'disabled' => $part_bill_event->disabled, + }; + + my $error = $part_event->insert(\%plandata); + die "error inserting part_event: $error\n" if $error; + + print ' '. $part_event->eventpart; + + my $once = new FS::part_event_condition { + 'eventpart' => $part_event->eventpart, + 'conditionname' => 'once' + }; + $error = $once->insert; + die $error if $error; + + my $balance = new FS::part_event_condition { + 'eventpart' => $part_event->eventpart, + 'conditionname' => 'balance' + }; + $error = $balance->insert( 'balance' => 0 ); + die $error if $error; + + my $cust_bill_owed = new FS::part_event_condition { + 'eventpart' => $part_event->eventpart, + 'conditionname' => 'cust_bill_owed' + }; + $error = $cust_bill_owed->insert( 'owed' => 0 ); + die $error if $error; + + my $payby = new FS::part_event_condition { + 'eventpart' => $part_event->eventpart, + 'conditionname' => 'payby' + }; + $error = $payby->insert( 'payby' => { $part_bill_event->payby => 1 } ); + die $error if $error; + + if ( $part_bill_event->seconds ) { + + my $age = new FS::part_event_condition { + 'eventpart' => $part_event->eventpart, + 'conditionname' => 'cust_bill_age' + }; + $error = $age->insert( 'age' => ($part_bill_event->seconds/86400 ).'d' ); + die $error if $error; + + } + + #my $derror = $part_bill_event->delete; + #die "error removing part_bill_event: $derror\n" if $derror; + + foreach my $cust_bill_event ( + qsearch({ + 'table' => 'cust_bill_event', + 'hashref' => { 'eventpart' => $part_bill_event->eventpart, }, + }) + ) { + + my $cust_event = new FS::cust_event { + 'eventpart' => $part_event->eventpart, + 'tablenum' => $cust_bill_event->invnum, + '_date' => $cust_bill_event->_date, + 'status' => $cust_bill_event->status, + 'statustext' => $cust_bill_event->statustext, + }; + + my $cerror = $cust_event->insert; + #die "error inserting cust_event: $cerror\n" if $cerror; + warn "error inserting cust_event: $cerror\n" if $cerror; + + #my $dcerror = $cust_bill_event->delete; + #die "error removing cust_bill_event: $dcerror\n" if $dcerror; + + print "."; + + } + + print "\n"; + +} + +sub usage { + die "Usage:\n freeside-migrate-events user\n"; +} + +=head1 NAME + +freeside-migrate-events - Migrates 1.7/1.8-style invoice events to + 1.9/2.0-style billing events + +=head1 SYNOPSIS + + freeside-migrate-events + +=head1 DESCRIPTION + +Migrates events from L<FS::part_bill_event> to L<FS::part_event> and friends, +and from L<FS::cust_bill_event> records to L<FS::cust_event> + +=head1 BUGS + +Doesn't migrate any action options yet. + +Doesn't translate option names that changed. + +Doesn't migrate reasons. + +Doesn't delete the old events (which is not a big deal, since the new code +won't run them...) + +=head1 SEE ALSO + +=cut + +1; + +__END__ + +#part_bill_event part_event +# +#eventpart n/a +#event event +#freq check_freq +#payby part_event_condition.conditionname = payby +#eventcode PARSE_WITH_REGEX (probably can just get from plandata) +#seconds part_event_condition.conditionname = cust_bill_age +#plandata PARSE_WITH_REGEX (along with eventcode, yuck) +#reason part_event_option.optionname = reason +#disabled disabled +# + + #these might help parse existing eventcode + + $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"; + }; + + } + + diff --git a/bin/freeside-session-kill b/bin/freeside-session-kill new file mode 100755 index 000000000..d5fd703f6 --- /dev/null +++ b/bin/freeside-session-kill @@ -0,0 +1,103 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($conf); +use Fcntl qw(:flock); +use FS::UID qw(adminsuidsetup datasrc dbh); +use FS::Record qw(dbdef qsearch fields); +use FS::session; +use FS::svc_acct; + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $sessionlock = "/usr/local/etc/freeside/session-kill.lock.". datasrc; + +open(LOCK,"+>>$sessionlock") or die "Can't open $sessionlock: $!"; +select(LOCK); $|=1; select(STDOUT); +unless ( flock(LOCK,LOCK_EX|LOCK_NB) ) { + seek(LOCK,0,0); + my($pid)=<LOCK>; + chop($pid); + #no reason to start loct of blocking processes + die "Is another session kill process running under pid $pid?\n"; +} +seek(LOCK,0,0); +print LOCK $$,"\n"; + +$FS::UID::AutoCommit = 0; + +my $now = time; + +#uhhhhh + +use DBIx::DBSchema; +use DBIx::DBSchema::Table; #down this path lies madness +use DBIx::DBSchema::Column; + +my $dbdef = dbdef or die; +#warn $dbdef; +#warn $dbdef->{'tables'}; +#warn keys %{$dbdef->{'tables'}}; +my $session_table = $dbdef->table('session') or die; +my $svc_acct_table = $dbdef->table('svc_acct') or die; + +my $session_svc_acct = new DBIx::DBSchema::Table ( 'session,svc_acct', '', '', '', + map( DBIx::DBSchema::Column->new( "session.$_", + $session_table->column($_)->type, + $session_table->column($_)->null, + $session_table->column($_)->length, + ), $session_table->columns() ), + map( DBIx::DBSchema::Column->new( "svc_acct.$_", + $svc_acct_table->column($_)->type, + $svc_acct_table->column($_)->null, + $svc_acct_table->column($_)->length, + ), $svc_acct_table->columns ), +# map("svc_acct.$_", $svc_acct_table->columns), +); + +$dbdef->addtable($session_svc_acct); #madness, i tell you + +$FS::Record::DEBUG = 1; +my @session = qsearch('session,svc_acct', {}, '', ' WHERE '. join(' AND ', + 'svc_acct.svcnum = session.svcnum', + '( session.logout IS NULL OR session.logout = 0 )', + "( $now - session.login ) >= svc_acct.seconds" +). " FOR UPDATE" ); + +my $dbh = dbh; + +foreach my $join ( @session ) { + + my $session = new FS::session ( { + map { $_ => $join->{'Hash'}{"session.$_"} } fields('session') + } ); #see no evil + + my $svc_acct = new FS::svc_acct ( { + map { $_ => $join->{'Hash'}{"svc_acct.$_"} } fields('svc_acct') + } ); + + #false laziness w/ fs_session_server + my $nsession = new FS::session ( { $session->hash } ); + my $error = $nsession->replace($session); + if ( $error ) { + $dbh->rollback; + die $error; + } + my $time = $nsession->logout - $nsession->login; + my $new_svc_acct = new FS::svc_acct ( { $svc_acct->hash } ); + my $seconds = $new_svc_acct->seconds; + $seconds -= $time; + $seconds = 0 if $seconds < 0; + $new_svc_acct->seconds( $seconds ); + $error = $new_svc_acct->replace( $svc_acct ); + warn "can't debit time from ". $svc_acct->username. ": $error\n"; #don't want to rollback, though + #ssenizal eslaf + +} + +$dbh->commit or die $dbh->errstr; + +sub usage { + die "Usage:\n\n freeside-session-kill user\n"; +} diff --git a/bin/freeside-upgrade-unicode b/bin/freeside-upgrade-unicode new file mode 100755 index 000000000..c60336567 --- /dev/null +++ b/bin/freeside-upgrade-unicode @@ -0,0 +1,72 @@ +#!/bin/bash + +# based on example code from +# http://blog.larik.nl:80/articles/2006/03/13/upgrade-your-postgresql-databases-to-unicode +# by frodo larik / blog.larik.nl + +db=freeside + +# This script updates all dbs to use unicode + +dbhost='localhost' +username='freeside' +#odir=${HOME}/freeside_unicode_upgrade +odir=/home/ivan/FREESIDE_unicode_upgrade + +if [ "${db}X" == "X" ] +then + echo "I need a db for host ${dbhost} and username ${username} $db" + exit +fi + +if [ ! -d $odir ] +then + mkdir $odir || exit "Exit at mkdir" +fi + +#echo -n "Enter a comma-separated list of country codes to keep [US,CA]:" +#countries=`line` +#if [ "${countries}X" == "X" ] +#then +# countries='US,CA' +#fi + +echo "delete from cust_main_county where 0 = ( select count(*) from cust_main where cust_main_county.country = cust_main.country );" | su freeside -c 'psql freeside' + +dump_sql=${odir}/${db}_out.sql +conv_sql=${odir}/${db}_conv.sql +result_sql=${odir}/${db}_result.txt +sql_diff=${odir}/${db}.diff + +# 0. stop + +/etc/init.d/freeside stop || die "can't stop freeside" +/etc/init.d/apache stop || die "can't stop apache" +/etc/init.d/apache2 stop || die "can't stop apache" + +echo "Dumping $db database to $dump_sql" + +su $username -c "pg_dump --host=$dbhost --username=$username -D --format=p $db" >$dump_sql || exit "exit at pg_dump" + +echo "Removing invalid characters from the dump" + +iconv -c -f UTF-8 -t UTF-8 ${dump_sql} > ${conv_sql} || exit "exit at iconv" + +echo "*** Making a diff from the dump: check $sql_diff ***" + +diff $dump_sql $conv_sql > $sql_diff + +echo "Removing current database" + +su $freeside -c "dropdb --host=$dbhost --username=$username $db" || exit "exit at dropdb" + +echo "Creating a new databse" + +su freeside -c "createdb --encoding='unicode' --host=$dbhost --username=$username $db" || exit "exit at createdb" + +echo "Loading data into new database" +su freeside -c "psql -f $conv_sql -o $result_sql -h $dbhost -U $username $db" || exit "exit at psql ${extra_string}" + +# 99. +/etc/init.d/freeside start || die "oh no, can't start freeside" +/etc/init.d/apache start || die "oh no, can't start apache" diff --git a/bin/freeside.import b/bin/freeside.import new file mode 100644 index 000000000..fdfcc083e --- /dev/null +++ b/bin/freeside.import @@ -0,0 +1,146 @@ +#!/usr/bin/perl -w + +use strict; +use DBI; + +my $s_datasrc = 'DBI:mysql:host=ns1.enetonline.net;port=3307;user=ivan;dbname=freeside'; +my $s_dbuser = 'ivan'; +my $s_dbpass = ''; + +my $d_datasrc = 'DBI:Pg:dbname=freeside'; +my $d_dbuser = 'freeside'; +my $d_dbpass = ''; + +#my @tables = qw( +#addr_block +#agent +#agent_type +#cust_bill +#cust_bill_event +#cust_bill_pay +#cust_bill_pkg +#cust_bill_pkg_detail +#cust_credit +#cust_credit_bill +#cust_credit_refund +#cust_main +#cust_main_county +#cust_main_invoice +#cust_pay +#cust_pay_batch +#cust_pkg +#cust_refund +#cust_svc +#cust_tax_exempt +#domain_record +#export_svc +#h_addr_block +#h_agent +#h_agent_type +#h_cust_bill +#h_cust_bill_event +#h_cust_bill_pay +#h_cust_bill_pkg +#h_cust_bill_pkg_detail +#h_cust_credit +#h_cust_credit_bill +#h_cust_credit_refund +#h_cust_main +#h_cust_main_county +#h_cust_main_invoice +#h_cust_pay +#h_cust_pay_batch +#h_cust_pkg +#h_cust_refund +#h_cust_svc +#h_cust_tax_exempt +#h_domain_record +#h_export_svc +#h_msgcat +#h_nas +#h_part_bill_event +#h_part_export +#h_part_export_option +#h_part_pkg +#h_part_pop_local +#h_part_referral +#h_part_svc +#h_part_svc_column +#h_part_svc_router +#h_pkg_svc +#h_port +#h_prepay_credit +#h_queue +#h_queue_arg +#h_queue_depend +#h_radius_usergroup +#h_router +#h_router_field +#h_sb_field +#h_session +#h_svc_acct +#h_svc_acct_pop +#h_svc_broadband +#h_svc_domain +#h_svc_forward +#h_svc_www +#h_type_pkgs +#msgcat +#nas +#part_bill_event +#part_export +#part_export_option +#part_pkg + +my @tables = qw( +part_pop_local +part_referral +part_router_field +part_sb_field +part_svc +part_svc_column +part_svc_router +pkg_svc +port +prepay_credit +queue +queue_arg +queue_depend +radius_usergroup +router +router_field +sb_field +session +svc_acct +svc_acct_pop +svc_broadband +svc_domain +svc_forward +svc_www +type_pkgs +); + +my $s_dbh = DBI->connect($s_datasrc, $s_dbuser, $s_dbpass) or die $DBI::errstr; +my $d_dbh = DBI->connect($d_datasrc, $d_dbuser, $d_dbpass) or die $DBI::errstr; + +foreach my $table ( @tables ) { + $d_dbh->do("delete from $table"); + + my $s_sth = $s_dbh->prepare("select * from $table"); + $s_sth->execute or die $s_sth->errstr; + + my $row; + while ( $row = $s_sth->fetchrow_arrayref ) { + my $d_sth = $d_dbh->prepare( + "insert into $table ( ". + join(', ', @{$s_sth->{NAME}} ). + ' ) VALUES ( '. + join(', ', map { '?' } @{$s_sth->{NAME}} ). + ' )' + ) or die $d_dbh->errstr; + + $d_sth->execute(@$row) or die $d_sth->errstr; + + } +} + diff --git a/bin/fs-migrate-cust_tax_exempt b/bin/fs-migrate-cust_tax_exempt new file mode 100755 index 000000000..ede80b08e --- /dev/null +++ b/bin/fs-migrate-cust_tax_exempt @@ -0,0 +1,323 @@ +#!/usr/bin/perl -w + +use strict; +use Time::Local; +use Date::Format; +use Time::Duration; +use FS::UID qw(adminsuidsetup); +use FS::Record qw( qsearch dbh ); +use FS::cust_tax_exempt; +#use FS::cust_bill; +use FS::h_cust_bill; +use FS::h_cust_tax_exempt; +use FS::cust_bill_pkg; +use FS::cust_tax_exempt_pkg; +#use Data::Dumper; + +my $start = time; + +adminsuidsetup shift; + +my $fuz = 7; #seconds + + #site-specific rewrites +my %rewrite = ( + #cust_tax_exempt.exemptnum => { 'field' => 'newvalue', ... }, + '23' => { month=>10, year=>2005, invnum=>1640 }, + + #etc. +); + +my @cust_tax_exempt = qsearch('cust_tax_exempt', {} ); +my $num_cust_tax_exempt = scalar(@cust_tax_exempt); +my $num_cust_tax_exempt_migrated = 0; +my $total_cust_tax_exempt_migrated = 0; +my $num_cust_tax_exempt_pkg_migrated = 0; +my $total_cust_tax_exempt_pkg_migrated = 0; + +$FS::UID::AutoCommit = 0; + +foreach my $cust_tax_exempt ( @cust_tax_exempt ) { + + if ( exists $rewrite{ $cust_tax_exempt->exemptnum } ) { + my $hashref = $rewrite{ $cust_tax_exempt->exemptnum }; + $cust_tax_exempt->setfield($_, $hashref->{$_}) + foreach keys %$hashref; + } + + if ( $cust_tax_exempt->year < 1990 ) { + warn "exemption year is ". $cust_tax_exempt->year. + "; not migrating exemption ". $cust_tax_exempt->exemptnum. + ' for custnum '. $cust_tax_exempt->custnum. "\n\n"; + next; + } + + # also make sure cust_bill_pkg record dates contain the month/year +# my $mon = $cust_tax_exempt->month; +# my $year = $cust_tax_exempt->year; +# $mon--; +# my $edate_after = timelocal(0,0,0,1,$mon,$year); +# $mon++; +# if ( $mon >= 12 ) { $mon-=12; $year++ }; +# my $sdate_before = timelocal(0,0,0,1,$mon,$year); + + my $mon = $cust_tax_exempt->month; + my $year = $cust_tax_exempt->year; + if ( $mon >= 12 ) { $mon-=12; $year++ }; + my $sdate_before = timelocal(0,0,0,1,$mon,$year); + #$mon++; + #if ( $mon >= 12 ) { $mon-=12; $year++ }; + my $edate_after = timelocal(0,0,0,1,$mon,$year); + + # !! start a transaction? (yes, its started) + + my @h_cust_tax_exempt = qsearch({ + 'table' => 'h_cust_tax_exempt', + 'hashref' => { 'exemptnum' => $cust_tax_exempt->exemptnum }, + 'extra_sql' => " AND ( history_action = 'insert' + OR history_action = 'replace_new' ) + ORDER BY history_date ASC + ", + }); + + my $amount_so_far = 0; + my $num_cust_tax_exempt_pkg = 0; + my $total_cust_tax_exempt_pkg = 0; + H_CUST_TAX_EXEMPT: foreach my $h_cust_tax_exempt ( @h_cust_tax_exempt ) { + + my $amount = sprintf('%.2f', $h_cust_tax_exempt->amount - $amount_so_far ); + $amount_so_far += $amount; + +# print Dumper($h_cust_tax_exempt), "\n"; + + #find a matching cust_bill record + # (print time differences and choose a meaningful threshold, should work) + + my @h_cust_bill = (); + if ( $cust_tax_exempt->invnum ) { + #warn "following invnum ". $cust_tax_exempt->invnum. + # " kludge for cust_tax_exempt ". $cust_tax_exempt->exemptnum. "\n"; + + @h_cust_bill = qsearch({ + #'table' => 'cust_bill', + 'table' => 'h_cust_bill', + 'hashref' => { 'custnum' => $h_cust_tax_exempt->custnum, + 'invnum' => $cust_tax_exempt->invnum, + 'history_action' => 'insert', + }, + #'extra_sql' => + # ' AND history_date <= '. ( $h_cust_tax_exempt->history_date + $fuz ). + # ' AND history_date > '. ( $h_cust_tax_exempt->history_date - $fuz ), + }); + + } else { + + @h_cust_bill = qsearch({ + #'table' => 'cust_bill', + 'table' => 'h_cust_bill', + 'hashref' => { 'custnum' => $h_cust_tax_exempt->custnum, + 'history_action' => 'insert', + }, + 'extra_sql' => + ' AND history_date <= '. ( $h_cust_tax_exempt->history_date + $fuz ). + ' AND history_date > '. ( $h_cust_tax_exempt->history_date - $fuz ), + }); + + } + + if ( scalar(@h_cust_bill) != 1 ) { + warn ' '. scalar(@h_cust_bill). ' h_cust_bill records matching '. + 'h_cust_tax_exempt.historynum '. $h_cust_tax_exempt->historynum. + "; not migrating (adjust fuz factor?)\n"; + next; + } + + my $h_cust_bill = $h_cust_bill[0]; + +# print Dumper(@cust_bill), "\n\n"; + + # then find a matching cust_bill_pkg record with part_pkg.taxclass record + # that matches the one pointed to by cust_tax_exempt.taxnum + # (hopefully just one, see how many we can match automatically) + + my $cust_main_county = $cust_tax_exempt->cust_main_county; + my $taxclass = $cust_main_county->taxclass; + + my $hashref = { + 'custnum' => $cust_tax_exempt->custnum, + 'invnum' => $h_cust_bill->invnum, + 'pkgnum' => { op=>'>', value=>0, }, + }; + unless ( $cust_tax_exempt->invnum ) { + # also make sure cust_bill_pkg record dates contain the month/year + + #$hashref->{'sdate'} = { op=>'<', value=>$sdate_before }; + $hashref->{'sdate'} = { op=>'<=', value=>$sdate_before }; + + #$hashref->{'edate'} = { op=>'>', value=>$edate_after }; + $hashref->{'edate'} = { op=>'>=', value=>$edate_after }; + } + + if ( $cust_tax_exempt->billpkgnum ) { + $hashref->{'billpkgnum'} = $cust_tax_exempt->billpkgnum; + } + + my $extra_sql = 'ORDER BY billpkgnum'; + + $extra_sql = "AND taxclass = '$taxclass' $extra_sql" + unless $cust_tax_exempt->ignore_current_taxclass; + + my @cust_bill_pkg = qsearch({ + 'select' => 'cust_bill_pkg.*, part_pkg.freq', + 'table' => 'cust_bill_pkg', + 'addl_from' => 'LEFT JOIN cust_pkg using ( pkgnum ) '. + 'LEFT JOIN part_pkg using ( pkgpart ) ', + 'hashref' => $hashref, + 'extra_sql' => $extra_sql, + }); + + foreach my $cust_bill_pkg ( @cust_bill_pkg ) { + $cust_bill_pkg->exemptable_per_month( + sprintf('%.2f', + ( $cust_bill_pkg->setup + $cust_bill_pkg->recur ) + / + ( $cust_bill_pkg[0]->freq || 1 ) + ) + ); + } + + my(@cust_tax_exempt_pkg) = (); + if ( scalar(@cust_bill_pkg) == 1 + && $cust_bill_pkg[0]->exemptable_per_month >= $amount + ) + { + + my $cust_bill_pkg = $cust_bill_pkg[0]; + + # finally, create an appropriate cust_tax_exempt_pkg record + + push @cust_tax_exempt_pkg, new FS::cust_tax_exempt_pkg { + 'billpkgnum' => $cust_bill_pkg->billpkgnum, + 'taxnum' => $cust_tax_exempt->taxnum, + 'year' => $cust_tax_exempt->year, + 'month' => $cust_tax_exempt->month, + 'amount' => $amount, + }; + + } else { + +# warn ' '. scalar(@cust_bill_pkg). ' cust_bill_pkg records for invoice '. +# $h_cust_bill->invnum. +# "; not migrating h_cust_tax_exempt historynum ". +# $h_cust_tax_exempt->historynum. " for \$$amount\n"; +# warn " *** DIFFERENT DATES ***\n" +# if grep { $_->sdate != $cust_bill_pkg[0]->sdate +# || $_->edate != $cust_bill_pkg[0]->edate +# } @cust_bill_pkg; +# foreach ( @cust_bill_pkg ) { +# warn ' '. $_->billpkgnum. ': '. $_->setup. 's/'. $_->recur.'r'. +# ' '. time2str('%D', $_->sdate). '-'. time2str('%D', $_->edate). +# "\n"; +# } +# +# next; + + my $remaining = $amount; + foreach my $cust_bill_pkg ( @cust_bill_pkg ) { + last unless $remaining; + my $this_amount =sprintf('%.2f', + $remaining <= $cust_bill_pkg->exemptable_per_month + ? $remaining + : $cust_bill_pkg->exemptable_per_month + );; + + push @cust_tax_exempt_pkg, new FS::cust_tax_exempt_pkg { + 'billpkgnum' => $cust_bill_pkg->billpkgnum, + 'taxnum' => $cust_tax_exempt->taxnum, + 'year' => $cust_tax_exempt->year, + 'month' => $cust_tax_exempt->month, + 'amount' => $this_amount, + }; + + $remaining -= $this_amount; + + } + + } + + foreach my $cust_tax_exempt_pkg ( @cust_tax_exempt_pkg ) { + my $error = $cust_tax_exempt_pkg->insert; + #my $error = $cust_tax_exempt_pkg->check; + if ( $error ) { + warn "*** error inserting cust_tax_exempt_pkg record: $error\n"; + next; #not necessary.. H_CUST_TAX_EXEMPT; + + #not necessary, incorrect $total_cust_tax_exempt_pkg will error it out + # roll back at least the entire cust_tax_exempt transaction + # next CUST_TAX_EXEMPT; + } + + $num_cust_tax_exempt_pkg++; + + $total_cust_tax_exempt_pkg += $cust_tax_exempt_pkg->amount; + + } + + } + + $total_cust_tax_exempt_pkg = sprintf('%.2f', $total_cust_tax_exempt_pkg ); + + unless ( $total_cust_tax_exempt_pkg == $cust_tax_exempt->amount ) { + warn "total h_ amount $total_cust_tax_exempt_pkg != cust_tax_exempt.amount ". + $cust_tax_exempt->amount. + ";\n not migrating exemption ". $cust_tax_exempt->exemptnum. " for ". + $cust_tax_exempt->month. '/'. $cust_tax_exempt->year. + ' (custnum '. $cust_tax_exempt->custnum. ") ". + #"\n (sdate < ". time2str('%D', $sdate_before ). + "\n (sdate <= ". time2str('%D', $sdate_before ). " [$sdate_before]". + #' / edate > '. time2str('%D', $edate_after ). ')'. + ' / edate >= '. time2str('%D', $edate_after ). " [$edate_after])". + "\n\n"; + + # roll back at least the entire cust_tax_exempt transaction + dbh->rollback; + + # next CUST_TAX_EXEMPT; + next; + } + + # remove the cust_tax_exempt record + my $error = $cust_tax_exempt->delete; + if ( $error ) { + #roll back at least the entire cust_tax_exempt transaction + dbh->rollback; + + #next CUST_TAX_EXEMPT; + next; + } + + $num_cust_tax_exempt_migrated++; + $total_cust_tax_exempt_migrated += $cust_tax_exempt->amount; + + $num_cust_tax_exempt_pkg_migrated += $num_cust_tax_exempt_pkg; + $total_cust_tax_exempt_pkg_migrated += $total_cust_tax_exempt_pkg; + + # commit the transaction + dbh->commit; + +} + +$total_cust_tax_exempt_migrated = + sprintf('%.2f', $total_cust_tax_exempt_migrated ); +$total_cust_tax_exempt_pkg_migrated = + sprintf('%.2f', $total_cust_tax_exempt_pkg_migrated ); + +warn + "$num_cust_tax_exempt_migrated / $num_cust_tax_exempt (". + sprintf('%.2f', 100 * $num_cust_tax_exempt_migrated / $num_cust_tax_exempt). + '%) cust_tax_exempt records migrated ($'. $total_cust_tax_exempt_migrated. + ")\n to $num_cust_tax_exempt_pkg_migrated cust_tax_exempt_pkg records". + ' ($'. $total_cust_tax_exempt_pkg_migrated. ')'. + "\n in ". duration(time-$start). "\n" +; + diff --git a/bin/fs-migrate-part_svc b/bin/fs-migrate-part_svc new file mode 100755 index 000000000..b0f3ac57e --- /dev/null +++ b/bin/fs-migrate-part_svc @@ -0,0 +1,41 @@ +#!/usr/bin/perl + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch fields); +use FS::part_svc; + +my $user = shift or die &usage; +my $dbh = adminsuidsetup $user; + +my $oldAutoCommit = $FS::UID::AutoCommit; +local $FS::UID::AutoCommit = 0; + +foreach my $part_svc ( qsearch('part_svc', {} ) ) { + foreach my $field ( + grep { defined($part_svc->getfield($part_svc->svcdb.'__'.$_.'_flag') ) } + fields($part_svc->svcdb) + ) { + my $flag = $part_svc->getfield($part_svc->svcdb.'__'.$field.'_flag'); + if ( uc($flag) =~ /^([DF])$/ ) { + my $part_svc_column = new FS::part_svc_column { + 'svcpart' => $part_svc->svcpart, + 'columnname' => $field, + 'columnflag' => $1, + 'columnvalue' => $part_svc->getfield($part_svc->svcdb.'__'.$field), + }; + my $error = $part_svc_column->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + die $error; + } + } + } +} + +$dbh->commit or die $dbh->errstr; + +sub usage { + die "Usage:\n fs-migrate-part_svc user\n"; +} + diff --git a/bin/fs-migrate-payref b/bin/fs-migrate-payref new file mode 100755 index 000000000..158419706 --- /dev/null +++ b/bin/fs-migrate-payref @@ -0,0 +1,31 @@ +#!/usr/bin/perl + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_pay; +use FS::cust_refund; + +my $user = shift or die &usage; +my $dbh = adminsuidsetup $user; + +# apply payments to invoices + +foreach my $cust_pay ( qsearch('cust_pay', {} ) ) { + my $error = $cust_pay->upgrade_replace; + warn $error if $error; +} + +# apply refunds to credits + +foreach my $cust_refund ( qsearch('cust_refund') ) { + my $error = $cust_refund->upgrade_replace; + warn $error if $error; +} + +# ? apply credits to invoices + +sub usage { + die "Usage:\n fs-migrate-payref user\n"; +} + diff --git a/bin/fs-migrate-svc_acct_sm b/bin/fs-migrate-svc_acct_sm new file mode 100755 index 000000000..07f7b611c --- /dev/null +++ b/bin/fs-migrate-svc_acct_sm @@ -0,0 +1,227 @@ +#!/usr/bin/perl -Tw +# +# jeff@cmh.net 01-Jul-20 + +#to delay loading dbdef until we're ready +#BEGIN { $FS::Record::setup_hack = 1; } + +use strict; +use Term::Query qw(query); +#use DBI; +#use DBIx::DBSchema; +#use DBIx::DBSchema::Table; +#use DBIx::DBSchema::Column; +#use DBIx::DBSchema::ColGroup::Unique; +#use DBIx::DBSchema::ColGroup::Index; +use FS::Conf; +use FS::UID qw(adminsuidsetup datasrc checkeuid getsecrets); +use FS::Record qw(qsearch qsearchs); +use FS::svc_domain; +use FS::svc_forward; +use vars qw( $conf $old_default_domain %part_domain_svc %part_acct_svc %part_forward_svc $svc_acct $svc_acct_sm $error); + +die "Not running uid freeside!" unless checkeuid(); + +my $user = shift or die &usage; +getsecrets($user); + +$conf = new FS::Conf; +$old_default_domain = $conf->config('domain'); + +#needs to match FS::Record +#my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc; + +### +# This section would be the appropriate place to manipulate +# the schema & tables. +### + +## we need to add the domsvc to svc_acct +## we must add a svc_forward record.... +## I am thinking that the fields svcnum (int), destsvc (int), and +## dest (varchar (80)) are appropriate, with destsvc/dest an either/or +## much in the spirit of cust_main_invoice + +### +# massage the data +### + +my($dbh)=adminsuidsetup $user; + +$|=1; + +$FS::svc_Common::noexport_hack = 1; +$FS::svc_domain::whois_hack = 1; + +%part_domain_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_domain'}); +%part_acct_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'}); +%part_forward_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_forward'}); + +die "No services with svcdb svc_domain!\n" unless %part_domain_svc; +die "No services with svcdb svc_acct!\n" unless %part_acct_svc; +die "No services with svcdb svc_forward!\n" unless %part_forward_svc; + +my($svc_domain) = qsearchs('svc_domain', { 'domain' => $old_default_domain }); +if (! $svc_domain || $svc_domain->domain != $old_default_domain) { + print <<EOF; + +Your database currently does not contain a svc_domain record for the +domain $old_default_domain. Would you like me to add one for you? +EOF + + my($response)=scalar(<STDIN>); + chop $response; + if ($response =~ /^[yY]/) { + print "\n\n", &menu_domain_svc, "\n", <<END; +I need to create new domain accounts. Which service shall I use for that? +END + my($domain_svcpart)=&getdomainpart; + + $svc_domain = new FS::svc_domain { + 'domain' => $old_default_domain, + 'svcpart' => $domain_svcpart, + 'action' => 'M', + }; +# $error=$svc_domain->insert && die "Error adding domain $old_default_domain: $error"; + $error=$svc_domain->insert; + die "Error adding domain $old_default_domain: $error" if $error; + }else{ + print <<EOF; + + This program cannot function properly until a svc_domain record matching +your conf_dir/domain file exists. +EOF + + exit 1; + } +} + +print "\n\n", &menu_acct_svc, "\n", <<END; +I may need to create some new pop accounts and set up forwarding to them +for some users. Which service shall I use for that? +END +my($pop_svcpart)=&getacctpart; + +print "\n\n", &menu_forward_svc, "\n", <<END; +I may need to create some new forwarding for some users. Which service +shall I use for that? +END +my($forward_svcpart)=&getforwardpart; + +sub menu_domain_svc { + ( join "\n", map "$_: ".$part_domain_svc{$_}->svc, sort keys %part_domain_svc ). "\n"; +} +sub menu_acct_svc { + ( join "\n", map "$_: ".$part_acct_svc{$_}->svc, sort keys %part_acct_svc ). "\n"; +} +sub menu_forward_svc { + ( join "\n", map "$_: ".$part_forward_svc{$_}->svc, sort keys %part_forward_svc ). "\n"; +} +sub getdomainpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %part_domain_svc ]; + $^W=1; + $return; +} +sub getacctpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %part_acct_svc ]; + $^W=1; + $return; +} +sub getforwardpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %part_forward_svc ]; + $^W=1; + $return; +} + + +#migrate data + +my(@svc_accts) = qsearch('svc_acct', {}); +foreach $svc_acct (@svc_accts) { + my(@svc_acct_sms) = qsearch('svc_acct_sm', { + domuid => $svc_acct->getfield('uid'), + } + ); + + # Ok.. we've got the svc_acct record, and an array of svc_acct_sm's + # What do we do from here? + + # The intuitive: + # plop the svc_acct into the 'default domain' + # and then represent the svc_acct_sm's with svc_forwards + # they can be gussied up manually, later + # + # Perhaps better: + # when no svc_acct_sm exists, place svc_acct in 'default domain' + # when one svc_acct_sm exists, place svc_acct in corresponding + # domain & possibly create a svc_forward in 'default domain' + # when multiple svc_acct_sm's exists (in different domains) we'd + # better use the 'intuitive' approach. + # + # Specific way: + # as 'perhaps better,' but we may be able to guess which domain + # is correct by comparing the svcnum of domains to the username + # of the svc_acct + # + + # The intuitive way: + + my $def_acct = new FS::svc_acct ( { $svc_acct->hash } ); + $def_acct->setfield('domsvc' => $svc_domain->getfield('svcnum')); + $error = $def_acct->replace($svc_acct); + die "Error replacing svc_acct for " . $def_acct->username . " : $error" if $error; + + foreach $svc_acct_sm (@svc_acct_sms) { + + my($domrec)=qsearchs('svc_domain', { + svcnum => $svc_acct_sm->getfield('domsvc'), + }) || die "svc_acct_sm references invalid domsvc $svc_acct_sm->getfield('domsvc')\n"; + + if ($svc_acct_sm->getfield('domuser') =~ /^\*$/) { + + my($newdom) = new FS::svc_domain ( { $domrec->hash } ); + $newdom->setfield('catchall', $svc_acct->svcnum); + $newdom->setfield('action', "M"); + $error = $newdom->replace($domrec); + die "Error replacing svc_domain for (anything)@" . $domrec->domain . " : $error" if $error; + + } else { + + my($newacct) = new FS::svc_acct { + 'svcpart' => $pop_svcpart, + 'username' => $svc_acct_sm->getfield('domuser'), + 'domsvc' => $svc_acct_sm->getfield('domsvc'), + 'dir' => '/dev/null', + }; + $error = $newacct->insert; + die "Error adding svc_acct for " . $newacct->username . " : $error" if $error; + + my($newforward) = new FS::svc_forward { + 'svcpart' => $forward_svcpart, + 'srcsvc' => $newacct->getfield('svcnum'), + 'dstsvc' => $def_acct->getfield('svcnum'), + }; + $error = $newforward->insert; + die "Error adding svc_forward for " . $newacct->username ." : $error" if $error; + } + + $error = $svc_acct_sm->delete; + die "Error deleting svc_acct_sm for " . $svc_acct_sm->domuser ." : $error" if $error; + + }; + +}; + + +$dbh->commit or die $dbh->errstr; +$dbh->disconnect or die $dbh->errstr; + +print "svc_acct_sm records sucessfully migrated\n"; + +sub usage { + die "Usage:\n fs-migrate-svc_acct_sm user\n"; +} + diff --git a/bin/fs-radius-add-check b/bin/fs-radius-add-check new file mode 100755 index 000000000..4e4769e58 --- /dev/null +++ b/bin/fs-radius-add-check @@ -0,0 +1,68 @@ +#!/usr/bin/perl -Tw + +# quick'n'dirty hack of fs-setup to add radius attributes + +use strict; +use DBI; +use FS::UID qw(adminsuidsetup checkeuid getsecrets); +use FS::raddb; + +die "Not running uid freeside!" unless checkeuid(); + +my %attrib2db = + map { lc($FS::raddb::attrib{$_}) => $_ } keys %FS::raddb::attrib; + +my $user = shift or die &usage; +getsecrets($user); + +my $dbh = adminsuidsetup $user; + +### + +print "\n\n", <<END, ":"; +Enter the additional RADIUS check attributes you need to track for +each user, separated by whitespace. +END +my @attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; } + split(" ",&getvalue); + +sub getvalue { + my($x)=scalar(<STDIN>); + chop $x; + $x; +} + +### + +my($char_d) = 80; #default maxlength for text fields + +### + +foreach my $attribute ( @attributes ) { + + my $statement = + "ALTER TABLE svc_acct ADD COLUMN rc_$attribute varchar($char_d) NULL"; + my $sth = $dbh->prepare( $statement ) + or warn "Error preparing $statement: ". $dbh->errstr; + my $rc = $sth->execute + or warn "Error executing $statement: ". $sth->errstr; + + $statement = + "ALTER TABLE h_svc_acct ADD COLUMN rc_$attribute varchar($char_d) NULL"; + $sth = $dbh->prepare( $statement ) + or warn "Error preparing $statement: ". $dbh->errstr; + $rc = $sth->execute + or warn "Error executing $statement: ". $sth->errstr; + +} + +$dbh->commit or die $dbh->errstr; + +$dbh->disconnect or die $dbh->errstr; + +print "\n\n", "Now you must run dbdef-create.\n\n"; + +sub usage { + die "Usage:\n fs-radius-add-check user\n"; +} + diff --git a/bin/fs-radius-add-reply b/bin/fs-radius-add-reply new file mode 100755 index 000000000..3de01374f --- /dev/null +++ b/bin/fs-radius-add-reply @@ -0,0 +1,69 @@ +#!/usr/bin/perl -Tw + +# quick'n'dirty hack of fs-setup to add radius attributes + +use strict; +use DBI; +use FS::UID qw(adminsuidsetup checkeuid getsecrets); +use FS::raddb; + +die "Not running uid freeside!" unless checkeuid(); + +my %attrib2db = + map { lc($FS::raddb::attrib{$_}) => $_ } keys %FS::raddb::attrib; + +my $user = shift or die &usage; +getsecrets($user); + +my $dbh = adminsuidsetup $user; + +### + +print "\n\n", <<END, ":"; +Enter the additional RADIUS reply attributes you need to track for +each user, separated by whitespace. +END +my @attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; } + split(" ",&getvalue); + +sub getvalue { + my($x)=scalar(<STDIN>); + chop $x; + $x; +} + +### + +my($char_d) = 80; #default maxlength for text fields + +### + +foreach my $attribute ( @attributes ) { + + my $statement = + "ALTER TABLE svc_acct ADD COLUMN radius_$attribute varchar($char_d) NULL"; + my $sth = $dbh->prepare( $statement ) + or warn "Error preparing $statement: ". $dbh->errstr; + my $rc = $sth->execute + or warn "Error executing $statement: ". $sth->errstr; + + $statement = + "ALTER TABLE h_svc_acct ADD COLUMN radius_$attribute varchar($char_d) NULL"; + $sth = $dbh->prepare( $statement ) + or warn "Error preparing $statement: ". $dbh->errstr; + $rc = $sth->execute + or warn "Error executing $statement: ". $sth->errstr; + +} + +$dbh->commit or die $dbh->errstr; + +$dbh->disconnect or die $dbh->errstr; + +print "\n\n", "Now you must run dbdef-create.\n\n"; + +sub usage { + die "Usage:\n fs-radius-add-reply user\n"; +} + + diff --git a/bin/generate-prepay b/bin/generate-prepay new file mode 100755 index 000000000..cb4ba7fc6 --- /dev/null +++ b/bin/generate-prepay @@ -0,0 +1,35 @@ +#!/usr/bin/perl -w + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::prepay_credit; + +require 5.004; #srand(time|$$); + +my $user = shift or die &usage; +&adminsuidsetup( $user ); + +my $amount = shift or die &usage; + +my $seconds = shift or die &usage; + +my $num_digits = shift or die &usage; + +my $num_entries = shift or die &usage; + +for ( 1 .. $num_entries ) { + my $identifier = join( '', map int(rand(10)), ( 1 .. $num_digits ) ); + my $prepay_credit = new FS::prepay_credit { + 'identifier' => $identifier, + 'amount' => $amount, + 'seconds' => $seconds, + }; + my $error = $prepay_credit->insert; + die $error if $error; + print "$identifier\n"; +} + +sub usage { + die "Usage:\n\n generate-prepay user amount seconds num_digits num_entries"; +} + diff --git a/bin/generate-raddb b/bin/generate-raddb new file mode 100755 index 000000000..af21c05a8 --- /dev/null +++ b/bin/generate-raddb @@ -0,0 +1,53 @@ +#!/usr/bin/perl + +# usage: generate-raddb radius-server/raddb/dictionary* >raddb.pm +# i.e.: generate-raddb ~/freeradius/freeradius-1.0.5/share/dictionary* ~/wirelessoceans/dictionary.ip3networks ~/wtxs/dictionary.mot.canopy >raddb.pm.new +print <<END; +package FS::raddb; +use vars qw(%attrib); + +%attrib = ( +END + +while (<>) { + next if /^(#|\s*$|\$INCLUDE\s+)/; + next if /^(VALUE|VENDOR|BEGIN\-VENDOR|END\-VENDOR)\s+/; + /^(ATTRIBUTE|ATTRIB_NMC)\s+([\w\-\/]+)\s+/ or die $_; + $attrib = $2; + $dbname = lc($2); + $dbname =~ s/[\-\/]/_/g; + $dbname = substr($dbname,0,24); + while ( exists $hash{$dbname} ) { + #warn $dbname; + $dbname =~ s/(.)$//; + my $w = $1; + $w =~ tr/_a-z0-9/a-z0-9_/; + $dbname = "$dbname$w"; + } + $hash{$dbname} = $attrib; + #print "$2\n"; +} + +foreach ( sort keys %hash ) { +# print "$_\n" if length($_)>24; +# print substr($_,0,24),"\n" if length($_)>24; +# $max = length($_) if length($_)>$max; +# have to fudge things since everything >24 is *not* unique + + #print " '". substr($_,0,24). "' => '$hash{$_}',\n"; + print " '$_' ". ( " " x (24-length($_) ) ). "=> '$hash{$_}',\n"; +} + +print <<END; + + #NETC.NET.AU (RADIATOR?) + 'authentication_type' => 'Authentication-Type', + + #wtxs (dunno) + #'radius_operator' => 'Radius-Operator', + +); + +1; +END + diff --git a/bin/generate-table-module b/bin/generate-table-module new file mode 100755 index 000000000..509feeded --- /dev/null +++ b/bin/generate-table-module @@ -0,0 +1,92 @@ +#!/usr/bin/perl + +use FS::Schema qw( dbdef_dist ); + +my $table = shift; + +### +# add a new FS/FS/table.pm +### + +my %ut = ( #just guesses + 'int' => 'number', + 'number' => 'float', + 'varchar' => 'text', + 'text' => 'text', + 'serial' => 'number', +); + +my $dbdef_table = dbdef_dist->table($table) + or die "define table in Schema.pm first"; +my $primary_key = $dbdef_table->primary_key; + +open(SRC,"<eg/table_template.pm") or die $!; +-e "FS/FS/$table.pm" and die "FS/FS/$table.pm already exists!"; +open(DEST,">FS/FS/$table.pm") or die $!; + +while (my $line = <SRC>) { + + $line =~ s/table_name/$table/g; + + if ( $line =~ /^=item\s+field\s+-\s+description\s*$/ ) { + + foreach my $column ( $dbdef_table->columns ) { + print DEST "=item $column\n\n"; + if ( $column eq $primary_key ) { + print DEST "primary key\n\n"; + } else { + print DEST "$column\n\n"; + } + } + next; + + } elsif ( $line=~ /^(\s*)\$self->ut_numbern\('primary_key'\)\s*/ ) { + + print DEST "$1\$self->ut_numbern('$primary_key')\n" + if $primary_key; + next; + + } elsif ( + $line =~ /^(\s*)\|\|\s+\$self->ut_number\('validate_other_fields'\)\s*/ + ) { + + foreach my $column ( grep { $_ ne $primary_key } $dbdef_table->columns ) { + my $ut = $ut{$dbdef_table->column($column)->type}; + $ut .= 'n' if $dbdef_table->column($column)->null; + print DEST "$1|| \$self->ut_$ut('$column')\n"; + } + next; + + } + + print DEST $line; +} + +close SRC; +close DEST; + +### +# add FS/t/table.t +### + +open(TEST,">FS/t/$table.t") or die $!; +print TEST <<ENDTEST; +BEGIN { \$| = 1; print "1..1\\n" } +END {print "not ok 1\\n" unless \$loaded;} +use FS::$table; +\$loaded=1; +print "ok 1\\n"; +ENDTEST +close TEST; + +### +# add them to MANIFEST +### + +system('cvs edit FS/MANIFEST'); + +open(MANIFEST,">>FS/MANIFEST") or die $!; +print MANIFEST "FS/$table.pm\n", + "t/$table.t\n"; +close MANIFEST; + diff --git a/bin/generate-tests b/bin/generate-tests new file mode 100755 index 000000000..73fd29ecb --- /dev/null +++ b/bin/generate-tests @@ -0,0 +1,21 @@ +#!/usr/bin/perl +@files = glob('FS/*.pm'); +foreach (@files) { +# warn $_; + chomp; + s/^FS\///; + $f=$_; + $f=~s/pm$/t/; + $m=$_; + $m=~s/\.pm$//; + open(TEST,">t/$f"); + print "t/$f\n"; + print TEST + 'BEGIN { $| = 1; print "1..1\n" }'. "\n". + 'END {print "not ok 1\n" unless $loaded;}'. "\n". + "use FS::$m;\n". + '$loaded=1;'. "\n". + 'print "ok 1\n";'. "\n" + ; + close TEST; +} diff --git a/bin/import-county-tax-rates b/bin/import-county-tax-rates new file mode 100755 index 000000000..05798c9a2 --- /dev/null +++ b/bin/import-county-tax-rates @@ -0,0 +1,30 @@ +#!/usr/bin/perl +# +# import-county-tax-rates username state country <filename.csv +# example: import-county-tax-rates ivan CA US <taxes.csv +# +# rates.csv: taxrate,county + +use FS::UID qw(adminsuidsetup); +use FS::cust_main_county; + +my $user = shift; +adminsuidsetup $user; + +my($state, $country) = (shift, shift); + +while (<>) { + my($tax, $county) = split(','); #half-ass CSV parser + + my $cust_main_county = new FS::cust_main_county { + 'county' => $county, + 'state' => $state, + 'country' => $country, + 'tax' => $tax, + }; + + my $error = $cust_main_county->insert; + #my $error = $cust_main_county->check; + die $error if $error; + +} diff --git a/bin/ispman.ldap.import b/bin/ispman.ldap.import new file mode 100755 index 000000000..7495f47f8 --- /dev/null +++ b/bin/ispman.ldap.import @@ -0,0 +1,114 @@ +#!/usr/bin/perl -w + +use strict; +use Net::LDAP::LDIF; + +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearchs); +use FS::svc_domain; +use FS::svc_acct; + +my $user = shift or die; +adminsuidsetup($user); + +$FS::svc_Common::noexport_hack = 1; +$FS::svc_domain::whois_hack = 1; + +my $domain_svcpart = 1; +my $account_svcpart = 2; +my $mailbox_svcpart = 3; +my $fedweeknet_svcpart = 4; + +#my $ldif = +# Net::LDAP::LDIF->new( "ispman-06-23-04.ldif", "r", onerror => 'undef' ); +my $ldif = + Net::LDAP::LDIF->new( "ispman-06-23-04.ldif", "r", onerror => 'warn' ); + +#my %objectclass; + +my $acct = 0; +my $imported = 0; + +my $entry; +while ( $entry = $ldif->read_entry ) { + #warn "$entry\n"; + my %attributes = map { $_ => [ $entry->get_value( $_ ) ] } $entry->attributes; + + my $objectclass = join('/', @{$attributes{'objectclass'}} ); + + next unless $objectclass eq 'posixAccount/ispmanDomainUser/radiusprofile'; + + foreach my $attr ( keys %attributes ) { + print join( " => ", substr($attr.' 'x30,0,30), @{$attributes{ $attr }} ), "\n"; + #if ( $attr eq 'objectclass' ) { + # $objectclass{ join('/', @{$attributes{$attr}} ) }++; + #} + } + print "\n"; + + $acct++; + + my $email = $attributes{'maillocaladdress'}->[0]; + $email =~ /^(\w+)\@([\w\.\-]+)$/ or die $email; + die "$1 ne ". $attributes{'ispmanuserid'}->[0]. "\n" + unless lc($1) eq $attributes{'ispmanuserid'}->[0]; + my $username = lc($1); + my $domain = lc($2); + + my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ) + || new FS::svc_domain { 'svcpart' => $domain_svcpart, + 'domain' => $domain, + 'action' => 'N', + }; + + unless ( $svc_domain->svcnum ) { + my $error = $svc_domain->insert; + if ( $error ) { + die "inserting domain: $error\n"; + } + } + + ( my $password = $attributes{'userpassword'}->[0] ) =~ s/^\{crypt\}//; + + # pick svcpart + my $svcpart = $account_svcpart; + if ( $domain eq 'fedweeknet.com' ) { + $svcpart = $fedweeknet_svcpart; + } elsif ( $attributes{'dialupaccess'}->[0] =~ /(false|no)/i ) { + $svcpart = $mailbox_svcpart; + } + + my $dir = $attributes{'homedirectory'}->[0]; + $dir =~ s/\s+//g; + $dir =~ s/\@/_/; + + my $svc_acct = new FS::svc_acct { + 'svcpart' => $svcpart, + 'username' => $username, + '_password' => $password, + 'finger' => $attributes{'cn'}->[0], + 'domsvc' => $svc_domain->svcnum, + 'shell' => $attributes{'loginshell'}->[0], + 'uid' => $attributes{'uidnumber'}->[0], + 'gid' => $attributes{'gidnumber'}->[0], + 'dir' => $dir, + 'quota' => $attributes{'mailquota'}->[0], + }; + my $error = $svc_acct->insert; + #my $error = $svc_acct->check; + + if ( $error ) { + warn "$error\n"; + } else { + $imported++; + } + +} + +print "$imported of $acct imported\n"; + +#print "\n\n"; + +#foreach ( sort { $objectclass{$b} <=> $objectclass{$a} } keys %objectclass ) { +# print "$objectclass{$_}: $_\n"; +#} diff --git a/bin/mapsecrets2access_user b/bin/mapsecrets2access_user new file mode 100755 index 000000000..945f130ef --- /dev/null +++ b/bin/mapsecrets2access_user @@ -0,0 +1,87 @@ +#!/usr/bin/perl -w + +use strict; +use File::Copy "cp"; +use FS::UID qw(adminsuidsetup); +use FS::CurrentUser; +use FS::AccessRight; +use FS::Record qw(qsearchs qsearch); +use FS::access_group; +use FS::access_user; +use FS::access_usergroup; +use FS::access_right; +use FS::access_groupagent; +use FS::agent; + +$FS::CurrentUser::upgrade_hack = 1; +my $user = shift or die &usage; +adminsuidsetup $user; + +my $supergroup = qsearchs('access_group', { 'groupname' => 'Superuser' } ); +unless ( $supergroup ) { + + $supergroup = new FS::access_group { 'groupname' => 'Superuser' }; + my $error = $supergroup->insert; + die $error if $error; + + foreach my $rightname ( FS::AccessRight->rights ) { + my $access_right = new FS::access_right { + 'righttype' => 'FS::access_group', + 'rightobjnum' => $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' => $supergroup->groupnum, + 'agentnum' => $agent->agentnum, + }; + my $aga_error = $access_groupagent->insert; + die $aga_error if $aga_error; + } + +} +my $supergroupnum = $supergroup->groupnum; + +my $conf = new FS::Conf; +my $dir = $conf->base_dir; +my $mapsecrets = "$dir/mapsecrets"; +open(MAPSECRETS, "<$mapsecrets") or die "Can't open $mapsecrets: $!"; +while (<MAPSECRETS>) { + /([\w]+)\s+secrets\s*$/ or die "unparsable line in mapsecrets: $_"; + my $username = $1; + + next if qsearchs('access_user', { 'username' => $username } ); + + my $access_user = new FS::access_user { + 'username' => $username, + '_password' => 'notyet', + 'first' => 'Legacy', + 'last' => 'User', + }; + my $au_error = $access_user->insert; + die $au_error if $au_error; + + my $access_usergroup = new FS::access_usergroup { + 'usernum' => $access_user->usernum, + 'groupnum' => $supergroupnum, + }; + my $aug_error = $access_usergroup->insert; + die $aug_error if $aug_error; + +} +close MAPSECRETS; + +# okay to clobber mapsecrets now i guess +cp $mapsecrets, "$mapsecrets.bak$$"; +open(MAPSECRETS, ">$mapsecrets") or die $!; +print MAPSECRETS '* secrets'. "\n"; +close MAPSECRETS or die $!; + +sub usage { + die "Usage:\n mapsecrets2access_user user\n"; +} + diff --git a/bin/masonize b/bin/masonize new file mode 100755 index 000000000..509ef3ec8 --- /dev/null +++ b/bin/masonize @@ -0,0 +1,80 @@ +#!/usr/bin/perl + +foreach $file ( split(/\n/, `find . -depth -print`) ) { + next unless $file =~ /(cgi|html)$/; + open(F,$file) or die "can't open $file for reading: $!"; + @file = <F>; + #print "$file ". scalar(@file). "\n"; + close $file; + $newline = ''; #avoid prepending extraneous newlines + $all = join('',@file); + + $w = ''; + + $mode = 'html'; + while ( length($all) ) { + + if ( $mode eq 'html' ) { + + if ( $all =~ /^(.+?)(<%=?.*)$/s && $1 !~ /<%/s ) { + $w .= $1; + $all = $2; + next; + } elsif ( $all =~ /^<%=(.*)$/s ) { + $w .= '<%'; + $all = $1; + $mode = 'perlv'; + #die; + next; + } elsif ( $all =~ /^<%(.*)$/s ) { + $w .= $newline; $newline = "\n"; + $all = $1; + $mode = 'perlc'; + + #avoid newline prepend fix from borking indented first <% + $w =~ s/\n\s+\z/\n/; + $w .= "\n" if $w =~ /.+\z/; + + next; + } elsif ( $all !~ /<%/s ) { + $w .= $all; + last; + } else { + warn length($all); die; + } + die; + + } elsif ( $mode eq 'perlv' ) { + + if ( $all =~ /^(.*?%>)(.*)$/s ) { + $w .= $1; + $all=$2; + $mode = 'html'; + next; + } + die "unterminated <%= ??? (in $file):"; + + } elsif ( $mode eq 'perlc' ) { + + if ( $all =~ /^([^\n]*?)%>(.*)$/s ) { + $w .= "%$1\n"; + $all=$2; + $mode='html'; + next; + } + if ( $all =~ /^([^\n]*)\n(.*)$/s ) { + $w .= "%$1\n"; + $all=$2; + next; + } + + } else { die }; + + } + + system("chmod u+w $file"); + select W; $| = 1; select STDOUT; + open(W,">$file") or die "can't open $file for writing: $!"; + print W $w; + close W; +} diff --git a/bin/passwd.import b/bin/passwd.import new file mode 100755 index 000000000..8ab9e2ae3 --- /dev/null +++ b/bin/passwd.import @@ -0,0 +1,121 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw(%part_svc); +use Date::Parse; +use Term::Query qw(query); +use Net::SCP qw(iscp); +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(qsearch qsearchs); +use FS::svc_acct; +use FS::part_svc; + +my $user = shift or die &usage; +adminsuidsetup $user; + +push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others? + +my($spooldir)="/usr/local/etc/freeside/export.". datasrc; + +#$FS::svc_acct::nossh_hack = 1; +$FS::svc_Common::noexport_hack = 1; + +### + +%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'}); + +die "No services with svcdb svc_acct!\n" unless %part_svc; + +print "\n\n", &menu_svc, "\n", <<END; +Enter part number to import. +END +my($shell_svcpart)=&getpart; + +print "\n\n", <<END; +Enter the location and name of your _user_ passwd file, for example +"mail.isp.com:/etc/passwd" or "nis.isp.com:/etc/global/passwd" +END +my($loc_passwd)=&getvalue(":"); +iscp("root\@$loc_passwd", "$spooldir/passwd.import"); + +print "\n\n", <<END; +Enter the location and name of your _user_ shadow file, for example +"mail.isp.com:/etc/shadow" or "bsd.isp.com:/etc/master.passwd" +END +my($loc_shadow)=&getvalue(":"); +iscp("root\@$loc_shadow", "$spooldir/shadow.import"); + +sub menu_svc { + ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n"; +} +sub getpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %part_svc ]; + $^W=1; + $return; +} +sub getvalue { + my $prompt = shift; + $^W=0; # Term::Query isn't -w-safe + my $return = query $prompt, ''; + $^W=1; + $return; +} + +print "\n\n"; + +### + +open(PASSWD,"<$spooldir/passwd.import"); +open(SHADOW,"<$spooldir/shadow.import"); + +my(%password); +while (<SHADOW>) { + chop; + my($username,$password)=split(/:/); + #$password =~ s/^\!$/\*/; + #$password =~ s/\!+/\*SUSPENDED\* /; + $password =~ s/^NP$/\*/; + $password =~ s/^\*LK\*$/\*/; + $password{$username}=$password; +} + +while (<PASSWD>) { + chop; + my($username,$x,$uid,$gid,$finger,$dir,$shell) = split(/:/); + my $password = $password{$username}; + + my $svcpart = $shell_svcpart; + + #if ( qsearchs('svc_acct', { 'username' => $username } ) ) { + # warn "warning: $username already exists; skipping\n"; + # next; + #} + + my($svc_acct) = new FS::svc_acct ({ + 'svcpart' => $svcpart, + 'username' => $username, + '_password' => $password, + 'uid' => $uid, + 'gid' => $gid, + 'finger' => $finger, + 'dir' => $dir, + 'shell' => $shell, + #%{$allparam{$username}}, + }); + my($error); + $error=$svc_acct->insert; + if ( $error ) { + if ( $error =~ /duplicate/i ) { + warn "$username: $error"; + } else { + die "$username: $error"; + } + } + +} + +sub usage { + die "Usage:\n\n passwd.import user\n"; +} + diff --git a/bin/payment-faker b/bin/payment-faker new file mode 100755 index 000000000..03316e1c0 --- /dev/null +++ b/bin/payment-faker @@ -0,0 +1,54 @@ +#!/usr/bin/perl + +use Date::Parse; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_pay; +use FS::cust_credit; + +my $user; +$user = shift or die "usage: payment-faker $user"; +adminsuidsetup($user); + +for $month ( 1 .. 11 ) { + + print "month $month\n"; + + system(qq!freeside-daily -d "$month/1/2006" $user!); + + foreach my $cust_main ( qsearch('cust_main', {} ) ) { + next unless $cust_main->balance > 0; + my $item = ''; + if ( rand() > .95 ) { + $item = new FS::cust_credit { + 'amount' => $cust_main->balance, + '_date' => str2time("$month/1/2006"), + 'reason' => 'testing', + }; + } else { + + if ( rand() > .5 ) { + $payby = 'BILL'; + $payinfo = int(rand(10000)); + } else { + $payby = 'CARD'; + $payinfo = '4111111111111111'; + } + + $item = new FS::cust_pay { + 'paid' => $cust_main->balance, + '_date' => str2time("$month/1/2006"), + 'payby' => $payby, + 'payinfo' => $payinfo, + }; + } + + $item->custnum($cust_main->custnum); + my $error = $item->insert; + die $error if $error; + $cust_main->apply_payments; + $cust_main->apply_credits; + + } + +} diff --git a/bin/pg-readonly b/bin/pg-readonly new file mode 100644 index 000000000..ad69fbde2 --- /dev/null +++ b/bin/pg-readonly @@ -0,0 +1,24 @@ +#!/usr/bin/perl +# +# hack to update/add read-only permissions for a user on the db +# +# usage: pg-readonly freesideuser readonlyuser + +use strict; +use DBI; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(dbdef); + +my $user = shift or die &usage; +my $rouser = shift or die &usage; + +my $dbh = adminsuidsetup $user; + +foreach my $table ( dbdef->tables ) { + $dbh->do("GRANT SELECT ON $table TO $rouser"); + $dbh->commit(); + if ( my $pkey = dbdef->table($table)->primary_key ) { + $dbh->do("GRANT SELECT ON ${table}_${pkey}_seq TO $rouser"); + $dbh->commit(); + } +} diff --git a/bin/pg-version b/bin/pg-version new file mode 100755 index 000000000..b6cddb612 --- /dev/null +++ b/bin/pg-version @@ -0,0 +1,13 @@ +#!/usr/bin/perl -w + +use strict; +use FS::UID qw(adminsuidsetup dbh); + +my $user = shift or die &usage; +adminsuidsetup($user); + +print "pg_server_version: ". dbh->{'pg_server_version'}. "\n"; + +sub usage { + "\n\nUsage: pg-version username\n"; +}; diff --git a/bin/pod2x b/bin/pod2x new file mode 100755 index 000000000..6b7153f96 --- /dev/null +++ b/bin/pod2x @@ -0,0 +1,148 @@ +#!/usr/bin/perl -w + +use strict; +use WWW::Mediawiki::Client; +#sub WWW::Mediawiki::Client::pagename_to_url { +# my ($self, $name, $action) = @_; +# WWW::Mediawiki::Client::URLConstructionException->throw( +# error => 'No action supplied.', +# ) unless $action; +# WWW::Mediawiki::Client::URLConstructionException->throw( +# error => "Page name $name ends with '.wiki'.", +# ) if $name =~ /.wiki$/; +# my $char = $self->space_substitute; +# $name =~ s/ /$char/; +# my $lang = $self->language_code; +# my $host = $self->host; +# $host =~ s/__LANG__/$lang/g; +# my $wiki_path = $self->wiki_path; +# $wiki_path =~ s/__LANG__/$lang/g; +# my $protocol = $self->protocol; +# return "$protocol://$host/$wiki_path?" . ACTION . "=$action&" . TITLE . "=$name" . '&wpRecreate=1'; +#} + +my $mw_username = 'ivan'; +chomp( my $mw_password = `cat .mw-password` ); + +my $site_perl = "./FS"; +#my $html = "Freeside:1.7:Documentation:Developer"; +my $html = "Freeside:1.9:Documentation:Developer"; + +foreach my $dir ( + $html, + map "$html/$_", qw( bin FS FS/UI FS/part_export FS/part_pkg + FS/part_event FS/part_event/Condition FS/part_event/Action + FS/ClientAPI FS/Cron FS/Misc FS/Report FS/Report/Table + FS/TicketSystem FS/UI + FS/SelfService + ) +) { + -d $dir or mkdir $dir; +} + +$|=1; + +die "Can't find $site_perl" unless -d $site_perl; +#die "Can't find $catman" unless -d $catman; +-d $html or mkdir $html; + +my $count = 0; + +#make some useless links +foreach my $file ( + glob("$site_perl/bin/freeside-*"), +) { + next if $file =~ /\.pod$/; + #symlink $file, "$file.pod"; # or die "link $file to $file.pod: $!"; + #system("cp $file $file.pod"); + -e "$file.pod" or system("cp $file $file.pod"); +} + +my $mvs = WWW::Mediawiki::Client->new( + 'host' => 'www.freeside.biz', + 'wiki_path' => 'mediawiki/index.php', + 'username' => $mw_username, + 'password' => $mw_password, + #'commit_message' => 'import from POD' + ); + +$mvs->do_login; + +my @files; +if ( @ARGV ) { + @files = @ARGV; +} else { + @files = ( + glob("$site_perl/*.pm"), + glob("$site_perl/*/*.pm"), + glob("$site_perl/*/*/*.pm"), + glob("$site_perl/*/*/*/*.pm"), + glob("$site_perl/bin/*.pod"), + glob("./fs_selfservice/FS-SelfService/*.pm"), + glob("./fs_selfservice/FS-SelfService/*/*.pm"), + ); + +} + +foreach my $file (@files) { + next if $file =~ /(^|\/)blib\//; + next if $file =~ /(^|\/)CVS\//; + #$file =~ /\/([\w\-]+)\.pm$/ or die "oops file $file"; + my $name; + if ( $file =~ /fs_\w+\/FS\-\w+\/(.*)\.pm$/ ) { + $name = "FS/$1"; + } elsif ( $file =~ /$site_perl\/(.*)\.(pm|pod)$/ ) { + $name = $1; + } else { + die "oops file $file"; + } + + #exit if $count++ == 10; + + my $htmlroot = join('/', map '..',1..(scalar($file =~ tr/\///)-2)) || '.'; + + system "pod2wiki --style mediawiki $file >$html/$name.rawwiki"; + + if ( -e "$html/$name.rawwiki" ) { + print "processing $name\n"; + } else { + print "skipping $name\n"; + next; + }; + + $mvs->do_update("$html/$name.wiki"); + + open(RAW, "<$html/$name.rawwiki") or die $!; + open(WIKI,">$html/$name.wiki" ) or die $!; + while (<RAW>) { + s/\[\[([^#p][^\]]*)\]\]/"[[$html\/". w_e($1). "|$1]]"/ge; + print WIKI $_; + } + close RAW; + close WIKI; + + print " uploading to ". $mvs->filename_to_pagename("$html/$name.wiki"). "\n"; + $mvs->commit_message( 'import from POD' ); + $mvs->do_commit("$html/$name.wiki"); + +} + +sub w_e { + my $s = shift; + $s =~ s/_/ /g; + $s =~ s/::/\//g; + $s =~ s/^freeside-/bin\/freeside-/g; + $s; +} + + +## system "pod2text $file >$catman/$name.txt"; +## +# system "pod2html --podroot=$site_perl --podpath=./FS:./FS/UI:.:./bin --norecurse --htmlroot=$htmlroot $file >$html/$name.html"; +# #system "pod2html --podroot=$site_perl --htmlroot=$htmlroot $file >$html/$name.html"; +## system "pod2html $file >$html/$name.html"; +## + +#remove the useless links +unlink glob("$site_perl/bin/*.pod"); + diff --git a/bin/postfix.export b/bin/postfix.export new file mode 100755 index 000000000..61380da59 --- /dev/null +++ b/bin/postfix.export @@ -0,0 +1,122 @@ +#!/usr/bin/perl -w + +use strict; +#use File::Path; +use File::Rsync; +use Net::SSH qw(ssh); +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(qsearch); # qsearchs); +use FS::part_export; +#use FS::cust_pkg; +use FS::cust_svc; +#use FS::svc_domain; + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/postfix"; +mkdir $spooldir, 0700 unless -d $spooldir; + +my @exports = qsearch('part_export', { 'exporttype' => 'postfix' } ); + +my $rsync = File::Rsync->new({ + rsh => 'ssh', +# dry_run => 1, +}); + +foreach my $export ( @exports ) { + + my $machine = $export->machine; + my $prefix = "$spooldir/$machine"; + mkdir $prefix, 0700 unless -d $prefix; + + #construct %domain hash + + my $mydomain = $export->option('mydomain'); + my %domain; + foreach my $svc_forward ( $export->svc_x ) { + + my( $username, $domain ); + my $srcsvc_acct = $svc_forward->srcsvc_acct; + if ( $srcsvc_acct ) { + ( $username, $domain ) = ( $srcsvc_acct->username, $srcsvc_acct->domain ); + } elsif ( $svc_forward->src =~ /^([^@]*)\@([^@]+)$/ ) { + ( $username, $domain ) = ( $1, $2 ); + } else { + die "bad svc_forward record? svcnum ". $svc_forward->svcnum. "\n"; + } + + my( $dusername, $ddomain ); + my $dstsvc_acct = $svc_forward->dstsvc_acct; + if ( $dstsvc_acct ) { + $dusername = $dstsvc_acct->username; + $ddomain = $dstsvc_acct->domain; + } elsif ( $svc_forward->dst =~ /([^@]+)\@([^@]+)$/ ) { + ( $dusername, $ddomain ) = ( $1, $2 ); + } else { + die "bad svc_forward record? svcnum ". $svc_forward->svcnum. "\n"; + } + my $dest; + if ( $ddomain eq $mydomain ) { + $dest = $dusername; + } else { + $dest = "$dusername\@$ddomain"; + } + + push @{$domain{$domain}{$username}}, $dest; + + } + + #write aliases + + my $aliases = delete $domain{$mydomain}; + open(ALIASES, ">$prefix/aliases") or die "can't open $prefix/aliases: $!"; + foreach my $alias ( keys %$aliases ) { + print ALIASES "$alias: ". join(',', @{ $aliases->{$alias} } ). "\n"; + } + close ALIASES; + + #write virtual + + open(VIRTUAL, ">$prefix/virtual") or die "can't open $prefix/virtual: $!"; + foreach my $domain ( keys %domain ) { + print VIRTUAL "$domain DOMAIN\n"; + #foreach my $virtual ( sort { $a ne '' <=> $b ne '' } keys %{$domain{$domain}} ) { + foreach my $virtual ( sort { ( ($b ne '') <=> ($a ne '') ) || $a cmp $b } keys %{$domain{$domain}} ) { + print VIRTUAL "$virtual\@$domain ". + join(',', @{ $domain{$domain}{$virtual} } ). "\n"; + } + print VIRTUAL "\n"; + } + close VIRTUAL; + + #rsync + + my $user = $export->option('user'); + $rsync->exec( { + src => "$prefix/aliases", + dest => "$user\@$machine:". $export->option('aliases'), + } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err); +# warn $rsync->out; + + ssh("$user\@$machine", $export->option('newaliases') || 'newaliases'); +# ssh("$user\@$machine", "postfix reload"); + + $rsync->exec( { + src => "$prefix/virtual", + dest => "$user\@$machine:". $export->option('virtual'), + } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err); +# warn $rsync->out; + ssh("$user\@$machine", $export->option('postmap') + || 'postmap hash:/etc/postfix/virtual'); + ssh("$user\@$machine", $export->option('reload') || 'postfix reload'); + +} + +# ----- + +sub usage { + die "Usage:\n postfix.export user\n"; +} + + diff --git a/bin/postfix_courierimap.import b/bin/postfix_courierimap.import new file mode 100755 index 000000000..12c138b49 --- /dev/null +++ b/bin/postfix_courierimap.import @@ -0,0 +1,137 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw(%part_svc %domain_part_svc); +#use Date::Parse; +use DBI; +use Term::Query qw(query); +use FS::UID qw(adminsuidsetup); #datasrc +use FS::Record qw(qsearch qsearchs); +use FS::svc_acct; +use FS::part_svc; +use FS::svc_domain; + +my $user = shift or die &usage; +adminsuidsetup $user; + +#push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others? + +$FS::svc_Common::noexport_hack = 1; +$FS::svc_domain::whois_hack = 1; + +### + +%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'}); + +die "No services with svcdb svc_acct!\n" unless %part_svc; + +print "\n\n", &menu_svc, "\n", <<END; +Enter part number to import. +END +my $mailbox_svcpart = &getpart; + +%domain_part_svc = map { $_->svcpart, $_ } + qsearch('part_svc', { 'svcdb' => 'svc_domain'} ); + +die "No services with svcdb svc_domain!\n" unless %domain_part_svc; + +print "\n\n", &menu_domain_svc, "\n", <<END; +Enter part number for domains. +END +my $domain_svcpart = &getdomainpart; + +my $datasrc = &getvalue("\n\nEnter the DBI datasource:"); +my $db_user = &getvalue("\n\nEnter the database user:"); +my $db_pass = &getvalue("\n\nEnter the database password:"); + +sub menu_svc { + ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n"; +} +sub menu_domain_svc { + ( join "\n", map "$_: ".$domain_part_svc{$_}->svc, sort keys %domain_part_svc ). "\n"; +} +sub getpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %part_svc ]; + $^W=1; + $return; +} +sub getdomainpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %domain_part_svc ]; + $^W=1; + $return; +} +sub getvalue { + my $prompt = shift; + $^W=0; # Term::Query isn't -w-safe + my $return = query $prompt, ''; + $^W=1; + $return; +} + +print "\n\n"; + +### + +my $dbh = DBI->connect( $datasrc, $db_user, $db_pass ) + or die $DBI::errstr; + +my $sth = $dbh->prepare('SELECT username, password, crypt, name, domain FROM mailbox') + or die $dbh->errstr; +$sth->execute or die $sth->errstr; + +my $row; +while ( defined ( $row = $sth->fetchrow_arrayref ) ) { + my( $r_username, $password, $crypt, $finger, $r_domain ) = @$row; + + my( $username, $domain ); + if ( $r_username =~ /^([^@]+)\@([^@]+)$/ ) { + $username = $1; + $domain = $2; + } else { + $username = $r_username; + $domain = $r_domain; + } + my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ) + || new FS::svc_domain { + 'domain' => $domain, + 'svcpart' => $domain_svcpart, + 'action' => 'N', + }; + unless ( $svc_domain->svcnum ) { + my $error = $svc_domain->insert; + if ( $error ) { + die "can't insert domain $domain: $error\n"; + } + } + + $password = $crypt if $password eq '*CRYPTED*'; + + $finger =~ s/Outdoor Power.*$/Outdoor Power/; + + my $svc_acct = new FS::svc_acct { + 'svcpart' => $mailbox_svcpart, + 'username' => $username, + 'domsvc' => $svc_domain->svcnum, + '_password' => $password, + 'finger' => $finger, + }; + + my $error = $svc_acct->insert; + #my $error = $svc_acct->check; + if ( $error ) { + if ( $error =~ /duplicate/i ) { + warn "$r_username / $r_domain: $error"; + } else { + die "$r_username / $r_domain: $error"; + } + } + +} + +sub usage { + die "Usage:\n\n postfix_courierimap.import user\n"; +} + + diff --git a/bin/print-schema b/bin/print-schema new file mode 100755 index 000000000..886e3250b --- /dev/null +++ b/bin/print-schema @@ -0,0 +1,7 @@ +#!/usr/bin/perl + +use DBIx::DBSchema; + +$l = load DBIx::DBSchema "/usr/local/etc/freeside/dbdef.DBI:Pg:dbname=freeside"; + +print $l->pretty_print, "\n"; diff --git a/bin/rate-us.import b/bin/rate-us.import new file mode 100755 index 000000000..66ac5de94 --- /dev/null +++ b/bin/rate-us.import @@ -0,0 +1,109 @@ +#!/usr/bin/perl -w + +use strict; +#use Spreadsheet::ParseExcel; +use DBI; +use FS::UID qw(adminsuidsetup); +use FS::rate_region; +use FS::rate_prefix; +use FS::rate_region; + +my $ratenum = 1; + +my $user = shift or usage(); +adminsuidsetup $user; + +sub usage { + #die "Usage:\n\n rate.import user rates.xls worksheet_name"; + die "Usage:\n\n rate.import user"; +} + +my %rate_region; + +foreach my $file ( 'areas and rates US.xls', + 'areas and rates US2.xls', + 'areas and rates US3.xls', + ) +{ + + my $dbh = DBI->connect("DBI:Excel:file=$file") + or die "can't connect: $DBI::errstr"; + + #my $table = shift or usage(); + my $table = 'Sheet1'; + my $sth = $dbh->prepare("select * from $table") + or die "can't prepare: ". $dbh->errstr; + $sth->execute + or die "can't execute: ". $sth->errstr; + + while ( my $row = $sth->fetchrow_hashref ) { + + #print join(' - ', map $row->{$_}, qw( rate_center Code Area_Prefix Rate ) ). "\n"; + + my $regionname = $row->{'rate_center'}; + $regionname =~ s/\xA0//g; + #$regionname =~ s/\xE9/e/g; #e with accent aigu + $regionname =~ s/(^\s+|\s+$)//; + $regionname .= ', USA'; + + my $prefix = $row->{'area_prefix'}; + $prefix =~ s/\xA0//g; + $prefix =~ s/\s$//; + #my $prefixprefix = ''; + #if ( $prefix =~ /^\s*(\d+)\s*\((.*)\)\s*$/ ) { + # $prefixprefix = $1; + # $prefix = $2; + #} elsif ( $prefix =~ /^\s*\((\d{3})\)\s*(.*)$/ ) { + # $prefixprefix = $1; + # $prefix = $2; + #} + + my @rate_prefix = map { + #warn $row->{'rate_center'}. ": $prefixprefix$_\n"; + new FS::rate_prefix { + 'countrycode' => '1', # $row->{'Country'} + #'npa' => $prefixprefix.$_, + 'npa' => $_, + }; + } + split(/\s*[;,]\s*/, $prefix); + + + my $dest_detail = new FS::rate_detail { + 'ratenum' => $ratenum, + 'min_included' => 0, + 'min_charge' => + sprintf('%.2f', $row->{'rate'} ), + 'sec_granularity' => 60, + }; + + unless ( exists $rate_region{$regionname} ) { + + my $rate_region = new FS::rate_region { + 'regionname' => $regionname, + }; + + my $error = $rate_region->insert( 'rate_prefix' => \@rate_prefix, + 'dest_detail' => [ $dest_detail ], + ); + die $error if $error; + + $rate_region{$regionname} = $rate_region->regionnum; + + } else { + + foreach my $rate_prefix ( @rate_prefix ) { + $rate_prefix->regionnum($rate_region{$regionname}); + my $error = $rate_prefix->insert; + die $error if $error; + } + + #$rate_detail->dest_regionnum($rate_region{$regionname}); + #$error = $rate_detail->insert; + #die $error if $error; + + } + + } + +} diff --git a/bin/rate.import b/bin/rate.import new file mode 100755 index 000000000..fdd756d72 --- /dev/null +++ b/bin/rate.import @@ -0,0 +1,95 @@ +#!/usr/bin/perl + +use strict; +#use Spreadsheet::ParseExcel; +use DBI; +use FS::UID qw(adminsuidsetup); +use FS::rate_region; +use FS::rate_prefix; +use FS::rate_region; + +my $ratenum = 1; + +my $user = shift or usage(); +adminsuidsetup $user; + +#my $file = shift or usage(); +my $file = 'areas and rates.xls'; +my $dbh = DBI->connect("DBI:Excel:file=$file") + or die "can't connect: $DBI::errstr"; + +#my $table = shift or usage(); +my $table = 'areas_and_rates'; +my $sth = $dbh->prepare("select * from $table") + or die "can't prepare: ". $dbh->errstr; +$sth->execute + or die "can't execute: ". $sth->errstr; + +sub usage { + #die "Usage:\n\n rate.import user rates.xls worksheet_name"; + die "Usage:\n\n rate.import user"; +} + +## + +while ( my $row = $sth->fetchrow_hashref ) { + + #print join(' - ', map $row->{$_}, qw( Country Code Area_Prefix Rate ) ). "\n"; + + my $regionname = $row->{'Country'}; + $regionname =~ s/\xA0//g; + $regionname =~ s/\xE9/e/g; #e with accent aigu + $regionname =~ s/(^\s+|\s+$)//; + + #next if $regionname =~ /Sweden Telia Mobile/; + + my $rate_region = new FS::rate_region { + 'regionname' => $regionname, + }; + + my $prefix = $row->{'Area_Prefix'}; + $prefix =~ s/\xA0//g; + $prefix =~ s/\s$//; + my $prefixprefix = ''; + if ( $prefix =~ /^\s*(\d+)\s*\((.*)\)\s*$/ ) { + $prefixprefix = $1; + $prefix = $2; + } elsif ( $prefix =~ /^\s*\((\d{3})\)\s*(.*)$/ ) { + $prefixprefix = $1; + $prefix = $2; + } + + my @rate_prefix = (); + if ( $prefix =~ /\d/ ) { + + @rate_prefix = map { + #warn $row->{'Country'}. ": $prefixprefix$_\n"; + new FS::rate_prefix { + 'countrycode' => $row->{'Code'}, + 'npa' => $prefixprefix.$_, + }; + } + split(/\s*[;,]\s*/, $prefix); + + } else { + @rate_prefix = ( new FS::rate_prefix { + 'countycode' => $row->{'Code'}, + 'npa' => '', + }; + ); + } + + my $dest_detail = new FS::rate_detail { + 'ratenum' => $ratenum, + 'min_included' => 0, + 'min_charge' => + sprintf('%.2f', $row->{'Rate'} ), + 'sec_granularity' => 60, + }; + + my $error = $rate_region->insert( 'rate_prefix' => \@rate_prefix, + 'dest_detail' => [ $dest_detail ], + ); + die $error if $error; + +} diff --git a/bin/reset-cust_credit-otaker b/bin/reset-cust_credit-otaker new file mode 100755 index 000000000..93002d05a --- /dev/null +++ b/bin/reset-cust_credit-otaker @@ -0,0 +1,88 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($opt_d); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::cust_credit; +use FS::h_cust_credit; + +getopts('d:'); + +my $user = shift or die &usage; +adminsuidsetup $user; + +die &usage + unless ($opt_d); + +$FS::Record::nowarn_identical = 1; + +if ( $opt_d ) { + $opt_d =~ /^(\d+)$/ or die "invalid date"; +} else { + die "no date specified\n"; +} + +my @cust_credit = qsearch('cust_credit', { otaker => $user } ); +die "no credits found\n" unless @cust_credit; + +my $cust_credit = new FS::cust_credit; +my @fields = grep { $_ !~ /^otaker|reason|reasonnum$/ } $cust_credit->fields; + +foreach my $cust_credit ( @cust_credit ) { + my %hash = $cust_credit->hash; + foreach (qw(otaker reason reasonnum)) { + delete $hash{$_}; + } + $hash{'history_action'} = 'replace_old'; + my $h_cust_credit = + qsearchs({ 'table' => 'h_cust_credit', + 'hashref' => \%hash, + 'select' => '*', + 'extra_sql' => " AND history_date <= $opt_d", + 'order_by' => 'ORDER BY history_date DESC LIMIT 1', + }); + if ($h_cust_credit) { + $cust_credit->otaker($h_cust_credit->otaker); + my $reason = $h_cust_credit->getfield('reason'); + if ($reason =~ /^\s*$/) { + $reason = '(none)'; + } + $cust_credit->otaker($h_cust_credit->otaker); + $cust_credit->reason($reason); + my $error = $cust_credit->replace + if $cust_credit->modified; + die "error replacing cust_credit: $error\n" + if $error; + }else{ + warn "Skipping credit.crednum ". $cust_credit->crednum; + } +} + +sub usage { + die "Usage:\n\n reset-cust_credit-otaker -d epoch_date user\n"; +} + +=head1 NAME + +reset-cust_credit-otaker - Command line tool to reset the otaker column for cust_credits to a previous value + +=head1 SYNOPSIS + + reset-cust_credit-otaker -d epoch_date user + +=head1 DESCRIPTION + + Sets the otaker column of the cust_credit records specified by user and + datespec to the value just prior to datespec. + + The reasonnum of the cust_credit record is also set to reason record + which matches the reason specified in the history. + +=head1 SEE ALSO + +L<FS::cust_credit>, L<FS::h_cust_credit>; + +=cut + diff --git a/bin/rollback b/bin/rollback new file mode 100755 index 000000000..7f83ef41a --- /dev/null +++ b/bin/rollback @@ -0,0 +1,38 @@ +#!/usr/bin/perl + +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs fields); + +use FS::svc_acct; + +#cust_pkg pkgnum 240133 241206 replace_old +#cust_svc svcnum 31102 32083 delete +#svc_acct svcnum 37162 37652 delete +my($user, $table, $pkey, $start, $end, $action) = @ARGV; + +adminsuidsetup $user or die; + +#eval "use FS::h_$table;"; +#die $@ if $@; +eval "use FS::$table;"; +die $@ if $@; + +my @history = grep { $_->historynum <= $end } qsearch("h_$table", { 'historynum' => { op=>'>=', value=>$start }, history_action => $action } ); + +my %seen; +foreach my $h (@history) { + my $error; + if ( $action eq 'replace_old' ) { + my $old = qsearchs($table, { $pkey => $h->get($pkey) } ); + unless ( $old ) { die "can't find $table $pkey ". $h->get($pkey). "\n"; } + my $new = "FS::$table"->new( { map { $_ => $h->get($_) } fields($table) } ); + $error = $new->replace($old); + } elsif ( $action eq 'delete' ) { + next if $seen{$h->get($pkey)}++; + my $new = "FS::$table"->new( { map { $_ => $h->get($_) } fields($table) } ); + $error = $new->insert; + } else { + die "unknown action $action\n"; + } + die $error if $error; +} diff --git a/bin/rotate-cdrs b/bin/rotate-cdrs new file mode 100755 index 000000000..7bef0bbb0 --- /dev/null +++ b/bin/rotate-cdrs @@ -0,0 +1,38 @@ +#!/usr/bin/perl -w + +use strict; +use Fcntl qw(:flock); +use IO::File; + +my $dir = '/usr/local/etc/freeside/export/cdr'; +#chdir $dir; + +#XXX glob might not handle lots of args at some point... +foreach my $file ( glob("$dir/*/CDR*-spool.CSV") ) { + + $file =~ m{(\d+)/CDR(\d+)-spool.CSV$} + or die "guru meditation #54: can't parse filename: $file\n"; + my($custnum, $date) = ($1, $2); + + + my $alpha = 'A'; + while ( -e "$dir/$custnum/CDR$date$alpha.CSV" ) { + $alpha++; # A -> Z -> AA etc. + } + my $newfile = "$dir/$custnum/CDR$date$alpha.CSV"; + + rename $file, $newfile + or die "$! moving $file to $newfile\n"; + + use IO::File; + my $lock = new IO::File ">>$newfile" + or die "can't open $newfile: $!\n"; + sleep 1; #just in case. i guess there's still a *remotely* possible + #race condition, but i'm not losing any sleep over it... (rimshot) + flock($lock, LOCK_EX) + or die "can't lock $newfile: $!\n"; + #okay we've got the lock, any pending write should be done... + + print "$custnum: $newfile\n"; + +} diff --git a/bin/rt-drop-tables b/bin/rt-drop-tables new file mode 100755 index 000000000..b027542b3 --- /dev/null +++ b/bin/rt-drop-tables @@ -0,0 +1,29 @@ +#!/usr/bin/perl + +my @tables = qw( +Attachments +Queues +Links +Principals +Groups +ScripConditions +Transactions +Scrips +ACL +GroupMembers +CachedGroupMembers +Users +Tickets +ScripActions +Templates +TicketCustomFieldValues +CustomFields +CustomFieldValues +sessions +); + +foreach my $table ( @tables ) { + print "drop table $table;\n"; + print "drop sequence ${table}_id_seq;\n"; +} + diff --git a/bin/rt-update-links b/bin/rt-update-links new file mode 100644 index 000000000..75d554f48 --- /dev/null +++ b/bin/rt-update-links @@ -0,0 +1,36 @@ +#!/usr/bin/perl + +use FS::UID qw(adminsuidsetup); + +my( $olddb, $newdb ) = ( shift, shift ); + +$FS::CurrentUser::upgrade_hack = 1; +my $dbh = adminsuidsetup; + +my $statement = "select * from links where base like 'fsck.com-rt://$olddb/%' OR target like 'fsck.com-rt://$olddb/%'"; + +my $sth = $dbh->prepare($statement) or die $dbh->errstr; +$sth->execute or die $sth->errstr; + +while ( my $row = $sth->fetchrow_hashref ) { + + ( my $base = $row->{'base'} ) + =~ s(^fsck\.com-rt://$olddb/)(fsck.com-rt://$newdb/); + + ( my $target = $row->{'target'} ) + =~ s(^fsck\.com-rt://$olddb/)(fsck.com-rt://$newdb/); + + if ( $row->{'base'} ne $base || $row->{'target'} ne $target ) { + + my $update = 'UPDATE links SET base = ?, target = ? where id = ?'; + my @param = ( $base, $target, $row->{'id'} ); + + warn "$update : ". join(', ', @param). "\n"; + $dbh->do($update, {}, @param ); + + } + +} + +$dbh->commit; + diff --git a/bin/sendmail.import b/bin/sendmail.import new file mode 100644 index 000000000..ef745fc46 --- /dev/null +++ b/bin/sendmail.import @@ -0,0 +1,178 @@ +#!/usr/bin/perl -w + +use strict; +use Term::Query qw(query); +use Net::SCP qw(iscp); +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(qsearch qsearchs); +##use FS::svc_acct_sm; +#use FS::svc_domain; +#use FS::domain_record; +use FS::svc_acct; +##use FS::part_svc; +use FS::svc_forward; +use FS::svc_domain; + +my $user = shift or die &usage; +adminsuidsetup $user; + +#$FS::svc_Common::noexport_hack = 1; +#$FS::domain_record::noserial_hack = 1; + +use vars qw($defaultdomain); +$defaultdomain = '295.ca'; + +use vars qw(@svcpart $forward_svcpart); +@svcpart = qw( 2 4 ); +$forward_svcpart = 7; + +use vars qw($spooldir); +$spooldir = "/usr/local/etc/freeside/export.". datasrc. "/sendmail"; +mkdir($spooldir, 0755) unless -d $spooldir; + +print "\n\n", <<END; +Enter the location and name of your Sendmail aliases file, for example +"mail.isp.com:/etc/mail/aliases" +END +my($aliases)=&getvalue(":"); + +use vars qw($aliases_machine $aliases_prefix); +$aliases_machine = (split(/:/, $aliases))[0]; +$aliases_prefix = "$spooldir/$aliases_machine"; +mkdir($aliases_prefix, 0755) unless -d $aliases_prefix; + +#iscp("root\@$aliases","$aliases_prefix/aliases.import"); +iscp("ivan\@$aliases","$aliases_prefix/aliases.import"); + +print "\n\n", <<END; +Enter the location and name of your Sendmail virtusertable directory, for example +"mail.isp.com:/etc/mail/virtusertable" +END +my($virtusertable)=&getvalue(":"); + +use vars qw($virtusertable_machine $virtusertable_prefix); +$virtusertable_machine = (split(/:/, $virtusertable))[0]; +$virtusertable_prefix = "$spooldir/$virtusertable_machine"; +mkdir($virtusertable_prefix, 0755) unless -d $virtusertable_prefix; +mkdir("$virtusertable_prefix/virtusertable.import", 0755) + unless -d "$virtusertable_prefix/virtusertable.import"; + +#iscp("root\@$virtusertable/*","$aliases_prefix/virtusertable.import/"); +iscp("ivan\@$virtusertable/*","$aliases_prefix/virtusertable.import/"); + +sub getvalue { + my $prompt = shift; + $^W=0; # Term::Query isn't -w-safe + my $return = query $prompt, ''; + $^W=1; + $return; +} + +print "\n\n"; + +## + +foreach my $file ( + "$aliases_prefix/aliases.import", + glob("$aliases_prefix/virtusertable.import/*"), +) { + + warn "importing $file\n"; + + open(FILE,"<$file") or die $!; + while (<FILE>) { + next if /^\s*#/ || /^\s*$/; #skip comments & blank lines + + unless ( /^([\w\@\.\-]+)[:\s]\s*(.*\S)\s*$/ ) { + warn "Unparsable line: $_"; + next; + } + my($rawusername, $rawdest) = ($1, $2); + + my($username, $domain); + if ( $rawusername =~ /^([\w\-\.\&]*)\@([\w\.\-]+)$/ ) { + $username = $1; + $domain = $2; + } elsif ( $rawusername =~ /\@/ ) { + die "Unparsable username: $rawusername\n"; + } else { + $username = $rawusername; + $domain = $defaultdomain; + } + + #find svc_acct record or set $src + my($srcsvc, $src) = &svcnum_or_literal($username, $domain); + + foreach my $dest ( split(/,/, $rawdest) ) { + + my($dusername, $ddomain); + if ( $dest =~ /^([\w\-\.\&]+)\@([\w\.\-]+)$/ ) { + $dusername = $1; + $ddomain = $2; + } elsif ( $dest =~ /\@/ ) { + die "Unparsable username: $dest\n"; + } else { + $dusername = $dest; + $ddomain = $defaultdomain; + } + my($dstsvc, $dst) = &svcnum_or_literal($dusername, $ddomain); + + my $svc_forward = new FS::svc_forward ({ + svcpart => $forward_svcpart, + srcsvc => $srcsvc, + src => $src, + dstsvc => $dstsvc, + dst => $dst, + }); + my $error = $svc_forward->insert; + #my $error = $svc_forward->check; + if ( $error ) { + die "$rawusername: $rawdest: $error\n"; + } + } + + + } #next entry + +} #next file + +## + +sub svcnum_or_literal { + my($username, $domain) = @_; + + my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ); + my $domsvc = $svc_domain ? $svc_domain->svcnum : ''; + + my @svc_acct = grep { my $svc_acct = $_; + grep { $svc_acct->cust_svc->svcpart == $_ } @svcpart + } + qsearch('svc_acct', { + 'username' => $username, + 'domsvc' => $domsvc, + }); + + if ( scalar(@svc_acct) > 1 ) { + die "multiple sources found for $username\@$domain !\n"; + } + + my( $svcnum, $literal ) = ('', ''); + if ( @svc_acct ) { + my $svc_acct = $svc_acct[0]; + $svcnum = $svc_acct->svcnum; + } else { + $literal = "$username\@$domain"; + } + + return( $svcnum, $literal ); + +} + +sub usage { + die "Usage:\n\n sendmail.import user\n"; +} + + + + + diff --git a/bin/sequences.reset b/bin/sequences.reset new file mode 100644 index 000000000..2dc1d3bb2 --- /dev/null +++ b/bin/sequences.reset @@ -0,0 +1,32 @@ +#!/usr/bin/perl + +use FS::UID qw(adminsuidsetup); +use FS::Record qw(dbdef dbh); + +my $user = shift; +adminsuidsetup $user or die; + +foreach my $table ( dbdef->tables ) { + my $primary_key = dbdef->table($table)->primary_key; + next unless $primary_key; + #my $local = dbdef->table($table)->column($primary_key)->local; + ##next unless $default =~ /nextval/; + #print "$local\n"; + + my $statement = "select setval('${table}_${primary_key}_seq', ( select max($primary_key) from $table ) )"; + + print "$statement;\n"; + next; + + my $sth = dbh->prepare($statement) or do { + warn dbh->errstr. " preparing $statement\n"; + next; + }; + $sth->execute or do { + warn dbh->errstr. " executing $statement\n"; + dbh->commit; + next; + } + +} + diff --git a/bin/shadow.reimport b/bin/shadow.reimport new file mode 100755 index 000000000..7957011eb --- /dev/null +++ b/bin/shadow.reimport @@ -0,0 +1,125 @@ +#!/usr/bin/perl -w +# +# -d: dry-run: make no changes +# -r: replace: overwrite existing passwords (otherwise only "*" passwords will +# be changed) +# -b: blowfish replace: overwrite existing passwords only if they are +# blowfish-encrypted + +use strict; +use vars qw(%part_svc); +use Getopt::Std; +use Term::Query qw(query); +use Net::SCP qw(iscp); +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(qsearch qsearchs); +use FS::svc_acct; +use FS::part_svc; + +use vars qw($opt_d $opt_r $opt_b); +getopts("drb"); + +my $user = shift or die &usage; +adminsuidsetup $user; + +push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others? + +my($spooldir)="/usr/local/etc/freeside/export.". datasrc; + +#$FS::svc_acct::nossh_hack = 1; +$FS::svc_Common::noexport_hack = 1; + +### + +%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'}); + +die "No services with svcdb svc_acct!\n" unless %part_svc; + +print "\n\n", &menu_svc, "\n", <<END; +Enter part number or part numbers to import. +END +my($shell_svcpart)=&getvalue; +my @shell_svcpart = split(/[,\s]+/, $shell_svcpart); + +print "\n\n", <<END; +Enter the location and name of your _user_ shadow file, for example +"mail.isp.com:/etc/shadow" or "bsd.isp.com:/etc/master.passwd" +END +my($loc_shadow)=&getvalue(":"); +iscp("root\@$loc_shadow", "$spooldir/shadow.import"); + +sub menu_svc { + ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n"; +} +sub getpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %part_svc ]; + $^W=1; + $return; +} +sub getvalue { + my $prompt = shift; + $^W=0; # Term::Query isn't -w-safe + my $return = query $prompt, ''; + $^W=1; + $return; +} + +print "\n\n"; + +### + +open(SHADOW,"<$spooldir/shadow.import"); + +my($line, $updated); +while (<SHADOW>) { + $line++; + chop; + my($username,$password)=split(/:/); + +# my @svc_acct = grep { $_->cust_svc->svcpart == $shell_svcpart } +# qsearch('svc_acct', { 'username' => $username } ); + my @svc_acct = grep { + my $svcpart = $_->cust_svc->svcpart; + grep { $_ == $svcpart } @shell_svcpart; + } qsearch('svc_acct', { 'username' => $username } ); + + next unless @svc_acct; + + if ( scalar(@svc_acct) > 1 ) { + die "more than one $username found!\n"; + next; + } + + my $svc_acct = shift @svc_acct; + + next unless $svc_acct->_password eq '*' + || $opt_r + || ( $opt_b && $svc_acct->_password =~ /^\$2a?\$/ ); + + next if $svc_acct->username eq 'root'; + + next if $password eq 'NP' || $password eq '*LK*'; + + next if $svc_acct->_password eq $password; + next if $svc_acct->_password =~ /^\*SUSPENDED\*/; + + my $new_svc_acct = new FS::svc_acct( { $svc_acct->hash } ); + $new_svc_acct->_password($password); + #warn "$username: ". $svc_acct->_password. " -> $password\n"; + warn "changing password for $username\n"; + unless ( $opt_d ) { + my $error = $new_svc_acct->replace($svc_acct); + die "$username: $error" if $error; + } + + $updated++; + +} + +warn "$updated of $line passwords changed\n"; + +sub usage { + die "Usage:\n\n shadow.reimport [ -d ] [ -r ] user\n"; +} + diff --git a/bin/slony-setup b/bin/slony-setup new file mode 100755 index 000000000..0798c1a03 --- /dev/null +++ b/bin/slony-setup @@ -0,0 +1,109 @@ +#!/usr/bin/perl +# +# slony replication setup +# +# usage: slony-setup freesideuser + +use strict; +use DBI; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(dbdef); + +my $user = shift or die "usage: slony-setup username\n"; +adminsuidsetup($user); + +#--- + +my $MASTERHOST = '192.168.20.10'; +my $SLAVEHOST = '192.168.20.50'; +#my $REPLICATIONUSER='pgsql'; +my $REPLICATIONUSER='postgres'; + +#-------- + +print <<END; + +#on slave: +useradd freeside +cp -pr /etc/skel /home/freeside +chown -R freeside /home/freeside + +su postgres -c 'createuser freeside' #n y n +su freeside -c 'createdb freeside' + +#on master: +su postgres -c 'createlang plpgsql freeside' + +pg_dump -s -U $REPLICATIONUSER -h $MASTERHOST freeside | psql -U $REPLICATIONUSER -h $SLAVEHOST freeside + +END + +#-------- + +#drop set ( id = 1, origin = 1); + +print <<END; +#on master: +slonik <<_EOF_ + +cluster name = freeside; +node 1 admin conninfo = 'dbname=freeside host=$MASTERHOST user=$REPLICATIONUSER'; +node 2 admin conninfo = 'dbname=freeside host=$SLAVEHOST user=$REPLICATIONUSER'; +init cluster ( id=1, comment = 'Master Node'); + +create set (id=1, origin=1, comment='All freeside tables'); + +END + +my $id = 1; + +foreach my $table ( dbdef->tables ) { + #next if $table =~ /^sql_/i; + print "set add table (set id=1, origin=1, id=". $id++. ", fully qualified name = 'public.$table' );\n"; + +} + +print <<END; + +store node (id=2, comment = 'Slave node'); +store path (server = 1, client = 2, conninfo='dbname=freeside host=$MASTERHOST user=$REPLICATIONUSER'); +store path (server = 2, client = 1, conninfo='dbname=freeside host=$SLAVEHOST user=$REPLICATIONUSER'); +store listen (origin=1, provider = 1, receiver =2); +store listen (origin=2, provider = 2, receiver =1); + +_EOF_ +END + +print <<END; + +### start slon processes (both machines) (this is debian-specific) +mkdir /etc/slony1/freeside + +cat >/etc/slony1/freeside/slon.conf <<_EOF_ +# Set the cluster name that this instance of slon is running against +# default is to read it off the command line +cluster_name='freeside' + +# Set slon's connection info, default is to read it off the command line +conn_info='host=localhost port=5432 dbname=freeside user=postgres' +_EOF_ + +/etc/init.d/slony1 start + +END + + +print <<END; +#on master: +slonik <<_EOF_ + +cluster name = freeside; + +node 1 admin conninfo = 'dbname=freeside host=$MASTERHOST user=$REPLICATIONUSER'; +node 2 admin conninfo = 'dbname=freeside host=$SLAVEHOST user=$REPLICATIONUSER'; + +subscribe set ( id = 1, provider = 1, receiver = 2, forward = no); + +_EOF_ +END + diff --git a/bin/sqlradius-norealm.reimport b/bin/sqlradius-norealm.reimport new file mode 100755 index 000000000..b7d016609 --- /dev/null +++ b/bin/sqlradius-norealm.reimport @@ -0,0 +1,113 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw(%part_svc); +#use Date::Parse; +use DBI; +use Term::Query qw(query); +use FS::UID qw(adminsuidsetup); #datasrc +use FS::Record qw(qsearch qsearchs); +use FS::svc_acct; +use FS::part_svc; + +my $user = shift or die &usage; +adminsuidsetup $user; + +#push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others? + +$FS::svc_Common::noexport_hack = 1; + +### + +%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'}); + +die "No services with svcdb svc_acct!\n" unless %part_svc; + +print "\n\n", &menu_svc, "\n", <<END; +Enter part number to import. +END +my $sqlradius_svcpart = &getpart; + +my $datasrc = &getvalue("\n\nEnter the DBI datasource:"); +my $db_user = &getvalue("\n\nEnter the database user:"); +my $db_pass = &getvalue("\n\nEnter the database password:"); + +sub menu_svc { + ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n"; +} +sub getpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %part_svc ]; + $^W=1; + $return; +} +sub getvalue { + my $prompt = shift; + $^W=0; # Term::Query isn't -w-safe + my $return = query $prompt, ''; + $^W=1; + $return; +} + +print "\n\n"; + +### + +my $dbh = DBI->connect( $datasrc, $db_user, $db_pass ) + or die $DBI::errstr; + +my $sth = $dbh->prepare('SELECT DISTINCT UserName FROM radcheck') + or die $dbh->errstr; +$sth->execute or die $sth->errstr; + +my $row; +while ( defined ( $row = $sth->fetchrow_arrayref ) ) { + my( $username ) = @$row; + + my( $password, $group ) = ( '', '', '' ); + + my $rc_sth = $dbh->prepare( + 'SELECT Attribute, Value'. + ' FROM radcheck'. + ' WHERE UserName = ?' + ) or die $dbh->errstr; + $rc_sth->execute($username) or die $rc_sth->errstr; + + foreach my $rc_row ( @{$rc_sth->fetchall_arrayref} ) { + my($attribute, $value) = @$rc_row; + if ( $attribute =~ /^((Crypt|User)-)?Password$/ ) { + $password = $value unless $password && !$1; + } else { + #handle other params! + } + } + + my @svc_acct = grep { $_->cust_svc->svcpart == $sqlradius_svcpart } + qsearch('svc_acct', { 'username' => $username, } ); + + #print "$r_username / $realm: $password / $finger: "; + print "$username: $password: "; + if ( scalar(@svc_acct) == 0 ) { + print "not found\n"; + next; + } elsif ( scalar(@svc_acct) > 1 ) { + print "multiple matches found?!?!\n"; + next; + } else { + #print "correcting password and name\n"; + print "correcting password\n"; + } + + my $svc_acct = $svc_acct[0]; + #my $new = new FS::svc_acct { $svc_acct->hash, '_password' => $password, 'finger' => $finger }; + my $new = new FS::svc_acct { $svc_acct->hash, '_password' => $password }; + my $error = $new->replace($svc_acct); + #my $error = $new->check; + die "$username: $error" if $error; + +} + +sub usage { + die "Usage:\n\n sqlradius-norealm.reimport user\n"; +} + diff --git a/bin/sqlradius.import b/bin/sqlradius.import new file mode 100644 index 000000000..e75f65b17 --- /dev/null +++ b/bin/sqlradius.import @@ -0,0 +1,152 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw(%part_svc %domain_part_svc); +#use Date::Parse; +use DBI; +use Term::Query qw(query); +use FS::UID qw(adminsuidsetup); #datasrc +use FS::Record qw(qsearch qsearchs); +use FS::svc_acct; +use FS::part_svc; +use FS::svc_domain; + +my $user = shift or die &usage; +adminsuidsetup $user; + +#push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others? + +$FS::svc_Common::noexport_hack = 1; +$FS::svc_domain::whois_hack = 1; + +### + +%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'}); + +die "No services with svcdb svc_acct!\n" unless %part_svc; + +print "\n\n", &menu_svc, "\n", <<END; +Enter part number to import. +END +my $sqlradius_svcpart = &getpart; + +%domain_part_svc = map { $_->svcpart, $_ } + qsearch('part_svc', { 'svcdb' => 'svc_domain'} ); + +die "No services with svcdb svc_domain!\n" unless %domain_part_svc; + +print "\n\n", &menu_domain_svc, "\n", <<END; +Enter part number for domains. +END +my $domain_svcpart = &getdomainpart; + +my $datasrc = &getvalue("\n\nEnter the DBI datasource:"); +my $db_user = &getvalue("\n\nEnter the database user:"); +my $db_pass = &getvalue("\n\nEnter the database password:"); + +sub menu_svc { + ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n"; +} +sub menu_domain_svc { + ( join "\n", map "$_: ".$domain_part_svc{$_}->svc, sort keys %domain_part_svc ). "\n"; +} +sub getpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %part_svc ]; + $^W=1; + $return; +} +sub getdomainpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %domain_part_svc ]; + $^W=1; + $return; +} +sub getvalue { + my $prompt = shift; + $^W=0; # Term::Query isn't -w-safe + my $return = query $prompt, ''; + $^W=1; + $return; +} + +print "\n\n"; + +### + +my $dbh = DBI->connect( $datasrc, $db_user, $db_pass ) + or die $DBI::errstr; + +my $sth = $dbh->prepare('SELECT DISTINCT UserName, Realm FROM radcheck') + or die $dbh->errstr; +$sth->execute or die $sth->errstr; + +my $row; +while ( defined ( $row = $sth->fetchrow_arrayref ) ) { + my( $r_username, $realm ) = @$row; + + my( $username, $domain ); + if ( $r_username =~ /^([^@]+)\@([^@]+)$/ ) { + $username = $1; + $domain = $2; + } else { + $username = $r_username; + $domain = $realm; + } + my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ) + || new FS::svc_domain { + 'domain' => $domain, + 'svcpart' => $domain_svcpart, + 'action' => 'N', + }; + unless ( $svc_domain->svcnum ) { + my $error = $svc_domain->insert; + if ( $error ) { + die "can't insert domain $domain: $error\n"; + } + } + + my( $password, $finger, $group ) = ( '', '', '' ); + + my $rc_sth = $dbh->prepare( + 'SELECT Attribute, Value, Name, GroupName'. + ' FROM radcheck'. + ' WHERE UserName = ? and Realm = ?' + ) or die $dbh->errstr; + $rc_sth->execute($r_username, $realm) or die $rc_sth->errstr; + + foreach my $rc_row ( @{$rc_sth->fetchall_arrayref} ) { + my($attribute, $value, $name, $groupname) = @$rc_row; + if ( $attribute =~ /^((User|Crypt)-)?Password$/ ) { + $password = $value; + $finger = $name; + $group = $groupname; + } else { + #handle other params! + } + } + + my $svc_acct = new FS::svc_acct { + 'svcpart' => $sqlradius_svcpart, + 'username' => $username, + 'domsvc' => $svc_domain->svcnum, + '_password' => $password, + 'finger' => $finger, + }; + + my $error = $svc_acct->insert; + #my $error = $svc_acct->check; + if ( $error ) { + if ( $error =~ /duplicate/i ) { + warn "$r_username / $realm: $error"; + } else { + die "$r_username / $realm: $error"; + } + } + +} + +sub usage { + die "Usage:\n\n sqlradius.import user\n"; +} + diff --git a/bin/sqlradius.reimport b/bin/sqlradius.reimport new file mode 100755 index 000000000..2218a3f13 --- /dev/null +++ b/bin/sqlradius.reimport @@ -0,0 +1,160 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw(%part_svc %domain_part_svc); +#use Date::Parse; +use DBI; +use Term::Query qw(query); +use FS::UID qw(adminsuidsetup); #datasrc +use FS::Record qw(qsearch qsearchs); +use FS::svc_acct; +use FS::part_svc; +use FS::svc_domain; + +my $user = shift or die &usage; +adminsuidsetup $user; + +#push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others? + +$FS::svc_Common::noexport_hack = 1; +$FS::svc_domain::whois_hack = 1; + +### + +%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'}); + +die "No services with svcdb svc_acct!\n" unless %part_svc; + +print "\n\n", &menu_svc, "\n", <<END; +Enter part number to import. +END +my $sqlradius_svcpart = &getpart; + +%domain_part_svc = map { $_->svcpart, $_ } + qsearch('part_svc', { 'svcdb' => 'svc_domain'} ); + +die "No services with svcdb svc_domain!\n" unless %domain_part_svc; + +print "\n\n", &menu_domain_svc, "\n", <<END; +Enter part number for domains. +END +my $domain_svcpart = &getdomainpart; + +my $datasrc = &getvalue("\n\nEnter the DBI datasource:"); +my $db_user = &getvalue("\n\nEnter the database user:"); +my $db_pass = &getvalue("\n\nEnter the database password:"); + +sub menu_svc { + ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n"; +} +sub menu_domain_svc { + ( join "\n", map "$_: ".$domain_part_svc{$_}->svc, sort keys %domain_part_svc ). "\n"; +} +sub getpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %part_svc ]; + $^W=1; + $return; +} +sub getdomainpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %domain_part_svc ]; + $^W=1; + $return; +} +sub getvalue { + my $prompt = shift; + $^W=0; # Term::Query isn't -w-safe + my $return = query $prompt, ''; + $^W=1; + $return; +} + +print "\n\n"; + +### + +my $dbh = DBI->connect( $datasrc, $db_user, $db_pass ) + or die $DBI::errstr; + +my $sth = $dbh->prepare('SELECT DISTINCT UserName, Realm FROM radcheck') + or die $dbh->errstr; +$sth->execute or die $sth->errstr; + +my $row; +while ( defined ( $row = $sth->fetchrow_arrayref ) ) { + my( $r_username, $realm ) = @$row; + + my( $username, $domain ); + if ( $r_username =~ /^([^@]+)\@([^@]+)$/ ) { + $username = $1; + $domain = $2; + } else { + $username = $r_username; + $domain = $realm; + } + my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ) + || new FS::svc_domain { + 'domain' => $domain, + 'svcpart' => $domain_svcpart, + 'action' => 'N', + }; + unless ( $svc_domain->svcnum ) { + die "new domain? wtf"; + my $error = $svc_domain->insert; + if ( $error ) { + die "can't insert domain $domain: $error\n"; + } + } + + #my( $password, $finger, $group ) = ( '', '', '' ); + my( $password, $group ) = ( '', '', '' ); + + my $rc_sth = $dbh->prepare( + 'SELECT Attribute, Value, Name, GroupName'. + ' FROM radcheck'. + ' WHERE UserName = ? and Realm = ?' + ) or die $dbh->errstr; + $rc_sth->execute($r_username, $realm) or die $rc_sth->errstr; + + foreach my $rc_row ( @{$rc_sth->fetchall_arrayref} ) { + my($attribute, $value, $name, $groupname) = @$rc_row; + if ( $attribute =~ /^((Crypt|User)-)?Password$/ ) { + $password = $value; + #$finger = $name; + $group = $groupname; + } else { + #handle other params! + } + } + + my @svc_acct = grep { $_->cust_svc->svcpart == $sqlradius_svcpart } + qsearch('svc_acct', { 'username' => $username, + 'domsvc' => $svc_domain->svcnum, } ); + + #print "$r_username / $realm: $password / $finger: "; + print "$r_username / $realm: $password: "; + if ( scalar(@svc_acct) == 0 ) { + print "not found\n"; + next; + } elsif ( scalar(@svc_acct) > 1 ) { + print "multiple matches found?!?!\n"; + next; + } else { + #print "correcting password and name\n"; + print "correcting password\n"; + } + + my $svc_acct = $svc_acct[0]; + #my $new = new FS::svc_acct { $svc_acct->hash, '_password' => $password, 'finger' => $finger }; + my $new = new FS::svc_acct { $svc_acct->hash, '_password' => $password }; + my $error = $new->replace($svc_acct); + #my $error = $new->check; + die "$r_username / $realm: $error" if $error; + +} + +sub usage { + die "Usage:\n\n sqlradius.reimport user\n"; +} + diff --git a/bin/strip-eps b/bin/strip-eps new file mode 100755 index 000000000..2c2d124d7 --- /dev/null +++ b/bin/strip-eps @@ -0,0 +1,20 @@ +#!/usr/bin/perl -w + +# Author: Andy Turner <andrew.turner@acadia.net> + +use strict; + +# The first line has some binary magic for file identification +# purposes. GhostScript doesn't like it. Strip it. +scalar <>; + +# Add a header so that we can use magic to determine the file type. +print "%!PS-Adobe-3.0 EPSF-3.0\n"; + +while (<>) { + print; + + # Illustrator Version 7 format EPS files have a bunch of binary gook + # after the "%%EOF" line. (% is a comment in PostScript, right?) + last if /^%%EOF/; +} diff --git a/bin/svc_acct.import b/bin/svc_acct.import new file mode 100755 index 000000000..aff26b943 --- /dev/null +++ b/bin/svc_acct.import @@ -0,0 +1,237 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw(%part_svc); +use Date::Parse; +use Term::Query qw(query); +use Net::SCP qw(iscp); +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(qsearch); +use FS::svc_acct; +use FS::part_svc; + +my $user = shift or die &usage; +adminsuidsetup $user; + +push @FS::svc_acct::shells, qw(/bin/sync /sbin/shuddown /bin/halt); #others? + +my($spooldir)="/usr/local/etc/freeside/export.". datasrc; + +$FS::svc_acct::nossh_hack = 1; + +### + +%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'}); + +die "No services with svcdb svc_acct!\n" unless %part_svc; + +print "\n\n", &menu_svc, "\n", <<END; +Most accounts probably have entries in passwd and users (with Port-Limit +nonexistant or 1). +END +my($ppp_svcpart)=&getpart; + +print "\n\n", &menu_svc, "\n", <<END; +Some accounts have entries in passwd and users, but with Port-Limit 2 (or +more). +END +my($isdn_svcpart)=&getpart; + +print "\n\n", &menu_svc, "\n", <<END; +Some accounts might have entries in users only (Port-Limit 1) +END +my($oppp_svcpart)=&getpart; + +print "\n\n", &menu_svc, "\n", <<END; +Some accounts might have entries in users only (Port-Limit >= 2) +END +my($oisdn_svcpart)=&getpart; + +print "\n\n", &menu_svc, "\n", <<END; +POP mail accounts have entries in passwd only, and have a particular shell. +END +my($pop_shell)=&getvalue("Enter that shell:"); +my($popmail_svcpart)=&getpart; + +print "\n\n", &menu_svc, "\n", <<END; +Everything else in passwd is a shell account. +END +my($shell_svcpart)=&getpart; + +print "\n\n", <<END; +Enter the location and name of your _user_ passwd file, for example +"mail.isp.com:/etc/passwd" or "nis.isp.com:/etc/global/passwd" +END +my($loc_passwd)=&getvalue(":"); +iscp("root\@$loc_passwd", "$spooldir/passwd.import"); + +print "\n\n", <<END; +Enter the location and name of your _user_ shadow file, for example +"mail.isp.com:/etc/shadow" or "bsd.isp.com:/etc/master.passwd" +END +my($loc_shadow)=&getvalue(":"); +iscp("root\@$loc_shadow", "$spooldir/shadow.import"); + +print "\n\n", <<END; +Enter the location and name of your radius "users" file, for example +"radius.isp.com:/etc/raddb/users" +END +my($loc_users)=&getvalue(":"); +iscp("root\@$loc_users", "$spooldir/users.import"); + +sub menu_svc { + ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n"; +} +sub getpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %part_svc ]; + $^W=1; + $return; +} +sub getvalue { + my $prompt = shift; + $^W=0; # Term::Query isn't -w-safe + my $return = query $prompt, ''; + $^W=1; + $return; +} + +print "\n\n"; + +### + +open(PASSWD,"<$spooldir/passwd.import"); +open(SHADOW,"<$spooldir/shadow.import"); +open(USERS,"<$spooldir/users.import"); + +my(%upassword,%ip,%allparam); +my(%param,$username); +while (<USERS>) { + chop; + next if /^\s*$/; + next if /^\s*#/; + if ( /^\S/ ) { + /^(\w+)\s+(Auth-Type\s+=\s+Local,\s+)?Password\s+=\s+"([^"]+)"(,\s+Expiration\s+=\s+"([^"]*")\s*)?$/ + or die "1Unexpected line in users.import: $_"; + my($password,$expiration); + ($username,$password,$expiration)=(lc($1),$3,$5); + $password = '' if $password eq 'UNIX'; + $upassword{$username}=$password; + undef %param; + } else { + die "2Unexpected line in users.import: $_"; + } + while (<USERS>) { + chop; + if ( /^\s*$/ ) { + if ( defined $param{'radius_Framed_IP_Address'} ) { + $ip{$username} = $param{'radius_Framed_IP_Address'}; + delete $param{'radius_Framed_IP_Address'}; + } else { + $ip{$username} = '0e0'; + } + $allparam{$username}={ %param }; + last; + } elsif ( /^\s+([\w\-]+)\s=\s"?([\w\.\-\s]+)"?,?\s*$/ ) { + my($attribute,$value)=($1,$2); + $attribute =~ s/\-/_/g; + $param{'radius_'.$attribute}=$value; + } else { + die "3Unexpected line in users.import: $_"; + } + } +} +#? incase there isn't a terminating blank line ? +if ( defined $param{'radius_Framed_IP_Address'} ) { + $ip{$username} = $param{'radius_Framed_IP_Address'}; + delete $param{'radius_Framed_IP_Address'}; +} else { + $ip{$username} = '0e0'; +} +$allparam{$username}={ %param }; + +my(%password); +while (<SHADOW>) { + chop; + my($username,$password)=split(/:/); + #$password =~ s/^\!$/\*/; + #$password =~ s/\!+/\*SUSPENDED\* /; + $password{$username}=$password; +} + +while (<PASSWD>) { + chop; + my($username,$x,$uid,$gid,$finger,$dir,$shell)=split(/:/); + my($password)=$upassword{$username} || $password{$username}; + + my($maxb)=${$allparam{$username}}{'radius_Port_Limit'}; + my($svcpart); + if ( exists $upassword{$username} ) { + if ( $maxb >= 2 ) { + $svcpart = $isdn_svcpart + } elsif ( ! $maxb || $maxb == 1 ) { + $svcpart = $ppp_svcpart + } else { + die "Illegal Port-Limit in users ($username)!\n"; + } + } elsif ( $shell eq $pop_shell ) { + $svcpart = $popmail_svcpart; + } else { + $svcpart = $shell_svcpart; + } + + my($svc_acct) = new FS::svc_acct ({ + 'svcpart' => $svcpart, + 'username' => $username, + '_password' => $password, + 'uid' => $uid, + 'gid' => $gid, + 'finger' => $finger, + 'dir' => $dir, + 'shell' => $shell, + 'slipip' => $ip{$username}, + %{$allparam{$username}}, + }); + my($error); + $error=$svc_acct->insert; + die $error if $error; + + delete $allparam{$username}; + delete $upassword{$username}; +} + +#my($username); +foreach $username ( keys %upassword ) { + my($password)=$upassword{$username}; + + my($maxb)=${$allparam{$username}}{'radius_Port_Limit'} || 0; + my($svcpart); + if ( $maxb == 2 ) { + $svcpart = $oisdn_svcpart + } elsif ( ! $maxb || $maxb == 1 ) { + $svcpart = $oppp_svcpart + } else { + die "Illegal Port-Limit in users!\n"; + } + + my($svc_acct) = new FS::svc_acct ({ + 'svcpart' => $svcpart, + 'username' => $username, + '_password' => $password, + 'slipip' => $ip{$username}, + %{$allparam{$username}}, + }); + my($error); + $error=$svc_acct->insert; + die $error, if $error; + + delete $allparam{$username}; + delete $upassword{$username}; +} + +# + +sub usage { + die "Usage:\n\n svc_acct.import user\n"; +} + diff --git a/bin/svc_acct_pop.import b/bin/svc_acct_pop.import new file mode 100755 index 000000000..9e3d38bfe --- /dev/null +++ b/bin/svc_acct_pop.import @@ -0,0 +1,59 @@ +#!/usr/bin/perl + +use strict; +use Text::CSV_XS; +use FS::UID qw(adminsuidsetup); +use FS::svc_acct_pop; + +my @fields = qw( ac loc state city exch ); +my $fixup = sub { + my $hash = shift; + $hash->{ac} =~ /^\s*(\d{3})\s*$/; + $hash->{ac} = $1; + $hash->{loc} =~ /^\s*(\d{3})(\d{4})\s*$/; + $hash->{exch} = $1; + $hash->{loc} = $2; + $hash->{state} =~ /^\s*(\S{0,2})\s*$/; + $hash->{state} = $1; + $hash->{city} =~ /^\s*(.*?)\s*$/; + $hash->{city} = $1; + + }; + +my $user = shift or usage(); +adminsuidsetup $user; + +my $file = shift or usage(); +my $csv = new Text::CSV_XS; + +open(FH, $file) or die "cannot open $file: $!"; + +sub usage { + die "Usage:\n\n svc_acct_pop.import user popfile.csv\n\n"; +} + +### + +my $line; +while ( defined($line=<FH>) ) { + chomp $line; + + $line &= "\177" x length($line); # i hope this isn't really necessary + $csv->parse($line) + or die "cannot parse: " . $csv->error_input(); + + my @values = $csv->fields(); + my %hash; + foreach my $field (@fields) { + $hash{$field} = shift @values; + } + + &{$fixup}(\%hash); + + my $svc_acct_pop = new FS::svc_acct_pop { %hash }; + + #my $error = $svc_acct_pop->check; + my $error = $svc_acct_pop->insert; + die $error if $error; + +} diff --git a/bin/svc_broadband.renumber b/bin/svc_broadband.renumber new file mode 100755 index 000000000..980fa0099 --- /dev/null +++ b/bin/svc_broadband.renumber @@ -0,0 +1,84 @@ +#!/usr/bin/perl + +use strict; + +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::svc_Common; +use FS::part_svc_router; +use FS::svc_broadband; +use FS::router; +use FS::addr_block; + +$FS::svc_Common::noexport_hack = 1; #Disable exports! + +my $user = shift if $ARGV[0] or die &usage; +adminsuidsetup($user); + +my $remapfile = shift if $ARGV[0] or die &usage; +my $old_blocknum = shift if $ARGV[0] or die &usage; +my $new_blocknum = shift if $ARGV[0] or die &usage; +my $old_svcnum = shift if $ARGV[0]; + +my %ipmap; + +open(REMAP, "<$remapfile") or die $!; +while (<REMAP>) { + next unless (/^([0-9\.]+)\s+([0-9\.]+)$/); + my ($old_ip, $new_ip) = ($1, $2); + $ipmap{$old_ip} = $new_ip; +} +close(REMAP); + +my @svcs; +if ($old_svcnum) { + @svcs = ( qsearchs('svc_broadband', { svcnum => $old_svcnum, + blocknum => $old_blocknum }) ); +} else { + @svcs = qsearch('svc_broadband', { blocknum => $old_blocknum }); +} + +foreach my $old_sb (@svcs) { + + my $old_ip = $old_sb->ip_addr; + my $new_ip = $ipmap{$old_ip}; + print "Renumbering ${old_ip} (${old_blocknum}) => ${new_ip} (${new_blocknum})...\n"; + + + my $new_sb = new FS::svc_broadband + { $old_sb->hash, + ip_addr => $new_ip, + blocknum => $new_blocknum, + svcpart => $old_sb->cust_svc->svcpart, + }; + + my $error = $new_sb->replace($old_sb); + die $error if $error; + +} + + + +exit(0); + +sub usage { + + my $usage = <<EOT; +Usage: + svc_broadband.renumber user remapfile old_blocknum new_blocknum [ svcnum ] + +remapfile format: +old_ip_address new_ip_address +... + +Example remapfile: +10.0.0.5 192.168.0.5 +10.0.0.20 192.168.0.20 +10.0.0.32 192.168.0.3 + +Warning: This assumes your routers have already been reconfigured with the + new addresses. Exports will not be run! + +EOT + +} diff --git a/bin/svc_domain.erase b/bin/svc_domain.erase new file mode 100755 index 000000000..435dd5fdd --- /dev/null +++ b/bin/svc_domain.erase @@ -0,0 +1,15 @@ +#!/usr/bin/perl -w + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); + +use FS::domain_record; +use FS::svc_domain; + +adminsuidsetup(shift @ARGV) or die "Usage: svc_domain.erase user\n"; + +foreach my $record ( qsearch('domain_record',{}), qsearch('svc_domain', {} ) ) { + my $error = $record->delete; + die $error if $error; +} diff --git a/bin/sysvshell.export b/bin/sysvshell.export new file mode 100755 index 000000000..c13912c3f --- /dev/null +++ b/bin/sysvshell.export @@ -0,0 +1,112 @@ +#!/usr/bin/perl -w + +# sysvshell export + +use strict; +use File::Rsync; +use Net::SSH qw(ssh); +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(qsearch qsearchs); +use FS::part_export; +use FS::cust_svc; +use FS::svc_acct; + +my @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $spooldir = "/usr/local/etc/freeside/export.". datasrc; +#my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/shell"; + +my @sysv_exports = qsearch('part_export', { 'exporttype' => 'sysvshell' } ); + +my $rsync = File::Rsync->new({ + rsh => 'ssh', +# dry_run => 1, +}); + +foreach my $export ( @sysv_exports ) { + my $machine = $export->machine; + my $prefix = "$spooldir/$machine"; + mkdir $prefix, 0700 unless -d $prefix; + + #LOCKING!!! + + ( open(SHADOW,">$prefix/shadow") + #!!! and flock(SHADOW,LOCK_EX|LOCK_NB) + ) or die "Can't open $prefix/shadow: $!"; + ( open(PASSWD,">$prefix/passwd") + #!!! and flock(PASSWD,LOCK_EX|LOCK_NB) + ) or die "Can't open $prefix/passwd: $!"; + + chmod 0644, "$prefix/passwd"; + chmod 0600, "$prefix/shadow"; + + my @svc_acct = $export->svc_x; + + next unless @svc_acct; + + foreach my $svc_acct ( sort { $a->uid <=> $b->uid } @svc_acct ) { + + my $password = $svc_acct->_password; + my $cpassword; + #if ( ( length($password) <= 8 ) + if ( ( length($password) <= 12 ) + && ( $password ne '*' ) + && ( $password ne '!!' ) + && ( $password ne '' ) + ) { + $cpassword=crypt($password, + $saltset[int(rand(64))].$saltset[int(rand(64))] + ); + # MD5 !!!! + } else { + $cpassword=$password; + } + + ### + # FORMAT OF THE PASSWD FILE HERE + print PASSWD join(":", + $svc_acct->username, + 'x', # "##". $username, + $svc_acct->uid, + $svc_acct->gid, + $svc_acct->finger, + $svc_acct->dir, + $svc_acct->shell, + ), "\n"; + + ### + # FORMAT OF THE SHADOW FILE HERE + print SHADOW join(":", + $svc_acct->username, + $cpassword, + '', + '', + '', + '', + '', + '', + '', + ), "\n"; + + } + + #!!! flock(SHADOW,LOCK_UN); + #!!! flock(PASSWD,LOCK_UN); + close SHADOW; + close PASSWD; + + $rsync->exec( { + src => "$prefix/shadow", + dest => "root\@$machine:/etc/shadow" + } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err); + + $rsync->exec( { + src => "$prefix/passwd", + dest => "root\@$machine:/etc/passwd" + } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err); + + # UNLOCK!! +} diff --git a/conf/agent_defaultpkg b/conf/agent_defaultpkg new file mode 100644 index 000000000..e69de29bb diff --git a/conf/alerter_template b/conf/alerter_template new file mode 100644 index 000000000..6fb66b77d --- /dev/null +++ b/conf/alerter_template @@ -0,0 +1,18 @@ + + +{ $company_name; } +{ $company_address; } + + +{ $first; } { $last; }: + + We thank you for your continuing patronage. This notice is to remind you +that your { $payby } used to pay { $company_name; } for Internet +service will expire on { use Date::Format; time2str("%B %o, %Y", $expdate); }. Please provide us with new +billing information so that we may continue your service uninterrupted. + +Very Truly Yours, + + { $company_name; } Service Team + + diff --git a/conf/blank_logo.eps b/conf/blank_logo.eps new file mode 100644 index 000000000..e7e3bab51 --- /dev/null +++ b/conf/blank_logo.eps @@ -0,0 +1,22 @@ +%!PS-Adobe-3.0 EPSF-3.0 +%%BoundingBox: 0 0 1 1 +%%HiResBoundingBox: 0 0 0 0 +%%Creator: Karbon14 EPS Exportfilter 0.5 +%%CreationDate: (01/03/2007 11:23:26 PM) +%%For: (ivan) () +%%Title: () + +/N {newpath} def +/C {closepath} def +/m {moveto} def +/c {curveto} def +/l {lineto} def +/s {stroke} def +/f {fill} def +/w {setlinewidth} def +/d {setdash} def +/r {setrgbcolor} def +/S {gsave} def +/R {grestore} def + +%%EOF diff --git a/conf/company_address b/conf/company_address new file mode 100644 index 000000000..38248622a --- /dev/null +++ b/conf/company_address @@ -0,0 +1,2 @@ +1234 Example Lane +Exampleton, CA 54321 diff --git a/conf/company_name b/conf/company_name new file mode 100644 index 000000000..2cd53232c --- /dev/null +++ b/conf/company_name @@ -0,0 +1 @@ +ExampleCo diff --git a/conf/cust_pkg-change_svcpart b/conf/cust_pkg-change_svcpart new file mode 100644 index 000000000..e69de29bb diff --git a/conf/declinetemplate b/conf/declinetemplate new file mode 100644 index 000000000..14b8c60ec --- /dev/null +++ b/conf/declinetemplate @@ -0,0 +1,10 @@ +Hi, + +Your credit card could not be processed for the following reason: + { $error } + +Please provide us with new billing information so that we may continue your +service uninterrupted. + +Thanks. + diff --git a/conf/home b/conf/home new file mode 100644 index 000000000..05280cb02 --- /dev/null +++ b/conf/home @@ -0,0 +1 @@ +/home diff --git a/conf/impending_recur_template b/conf/impending_recur_template new file mode 100644 index 000000000..deb396ac3 --- /dev/null +++ b/conf/impending_recur_template @@ -0,0 +1,20 @@ + + +{ $company_name; } +{ $company_address; } + + +{ $first; } { $last; }: + + We thank you for your continuing patronage. This notice is to remind you +that your { $packages->[0] } Internet service +will expire on { use Date::Format; time2str("%B %o, %Y", $recurdates->[0]); }. +At that time we will begin charging you on a recurring basis so that we may +continue your service uninterrupted. + +Very Truly Yours, + + { $company_name; } Service Team + + + diff --git a/conf/invoice_from b/conf/invoice_from new file mode 100644 index 000000000..110ec8f41 --- /dev/null +++ b/conf/invoice_from @@ -0,0 +1 @@ +ivan-unconfigured-freeside-installation@420.am diff --git a/conf/invoice_html b/conf/invoice_html new file mode 100644 index 000000000..9d97243e4 --- /dev/null +++ b/conf/invoice_html @@ -0,0 +1,166 @@ +<STYLE TYPE="text/css"> +.invoice { font-family: sans-serif; font-size: 10pt } +.invoice_header { font-size: 10pt } +.invoice_headerright TH { border-top: 2px solid #000000; border-bottom: 2px solid #000000 } +.invoice_headerright TD { font-size: 10pt; empty-cells: show } +.invoice_longtable table { cellspacing: none } +.invoice_longtable TH { border-top: 2px solid #000000; border-bottom: 1px solid #000000; padding-left: none; padding-right: none; font-size: 10pt } +.invoice_desc TD { border-top: 2px solid #000000; font-weight: bold; font-size: 10pt } +.invoice_extdesc TD { font-size: 8pt } +.invoice_totaldesc TD { font-size: 10pt; empty-cells: show } +</STYLE> + +<table class="invoice" bgcolor="#ffffff" WIDTH=768 CELLSPACING=8><tr><td> + + <table class="invoice_header" width="100%"> + <tr> + <td><img src="<%= $cid ? "cid:$cid" : "cust_bill-logo.cgi?$template" %>"></td> + <td align="left"><%= $returnaddress %></td> + <td align="right"> + <table CLASS="invoice_headerright" cellspacing=0> + <tr> + <td align="right"> + Invoice date<BR> + <B><%= $date %></B> + </td> + <td> + </td> + <td align="center"> + Invoice #<BR> + <B><%= $invnum %></B> + </td> + <td> + </td> + <td align="center"> + Customer #<BR> + <B><%= $custnum %></B> + </td> + </tr> + <tr> + <th> </th> + <th colspan=3 align="center"> + <FONT SIZE="+3">I</FONT><FONT SIZE="+2">NVOICE</FONT> + </th> + <th> </th> + </tr> + </table> + </td> + </tr> + + <tr> + <td> + </td> + <td align="left"> + <b><%= $payname %></b><BR> + <%= join('<BR>', grep length($_), $company, + $address1, + $address2, + "$city, $state  $zip", + $country, + ) + %> + </td> + <td align="right"> + Terms: <%= $terms %><BR> + <%= $po_line %> + </td> + </tr> + + </table> + + <%= + foreach my $section ( @sections ) { + $OUT .= '<table><tr><td>'; + if ($section->{'description'}) { + $OUT .= + '<p><b><font size="+1">'. uc(substr($section->{'description'},0,1)). + '</font><font size="+0">'. uc(substr($section->{'description'},1)). + '</font></b>'. + '<p>'; + }else{ + $OUT .= + '<p><b><font size="+1">C</font><font size="+0">HARGES</font></b>'. + '<p>'; + } + $OUT .= '</td></tr></table>'; + + $OUT .= + '<table class="invoice_longtable" CELLSPACING=0 WIDTH="100%">'. + '<tr>'. + '<th align="center">Ref</th>'. + '<th align="left">Description</th>'. + '<th align="right">Amount</th>'. + '</tr>'; + + foreach my $line ( + grep { ( scalar(@sections) > 1 + ? $section->{'description'} eq $_->{'section'}->{'description'} + : 1 + ) } + @detail_items ) + { + $OUT .= + '<tr class="invoice_desc">'. + '<td align="center">'. $line->{'ref'}. '</td>'. + '<td align="left">'. $line->{'description'}. '</td>'. + '<td align="right">'. $line->{'amount'}. '</td>'. + '</tr>' + ; + foreach my $ext_desc ( @{$line->{'ext_description'} } ) { + $OUT .= + '<tr class="invoice_extdesc">'. + '<td></td>'. + '<td align="left">- '. $ext_desc. '</td>'. + '<td></td>'. + '</tr>' + } + } + + + if (scalar(@sections) > 1) { + my $style = 'border-top: 3px solid #000000;'. + 'border-bottom: 3px solid #000000;'; + $OUT .= + '<tr class="invoice_totaldesc">'. + qq(<td style="$style"> </td>). + qq(<td align="left" style="$style">). + $section->{'description'}. ' Total </td>'. + qq(<td align="right" style="$style">). + $section->{'subtotal'}. '</td>'. + '</tr>' + ; + } + } + + my $style = 'border-top: 3px solid #000000;'; + my $linenum = 0; + + foreach my $line ( @total_items ) { + + $style .= 'border-bottom: 3px solid #000000;' + if ++$linenum == scalar(@total_items); + + $OUT .= + '<tr class="invoice_totaldesc">'. + qq(<td style="$style"> </td>). + qq(<td align="left" style="$style">). + $line->{'total_item'}. '</td>'. + qq(<td align="right" style="$style">). + $line->{'total_amount'}. '</td>'. + '</tr>' + ; + + $style=''; + + } + + %> + </table> + <br><br> + +<%= $notes %> + + <hr NOSHADE SIZE=2 COLOR="#000000"> + <p align="center"><%= $footer %> + +</td></tr></table> diff --git a/conf/invoice_html_statement b/conf/invoice_html_statement new file mode 100644 index 000000000..4e4d259af --- /dev/null +++ b/conf/invoice_html_statement @@ -0,0 +1,124 @@ +<STYLE TYPE="text/css"> +.invoice { font-family: sans-serif; font-size: 10pt } +.invoice_header { font-size: 10pt } +.invoice_headerright TH { border-top: 2px solid #000000; border-bottom: 2px solid #000000 } +.invoice_headerright TD { font-size: 10pt; empty-cells: show } +.invoice_longtable table { cellspacing: none } +.invoice_longtable TH { border-top: 2px solid #000000; border-bottom: 1px solid #000000; padding-left: none; padding-right: none; font-size: 10pt } +.invoice_desc TD { border-top: 2px solid #000000; font-weight: bold; font-size: 10pt } +.invoice_extdesc TD { font-size: 8pt } +.invoice_totaldesc TD { font-size: 10pt; empty-cells: show } +</STYLE> + +<table class="invoice" bgcolor="#ffffff" WIDTH=768 CELLSPACING=8><tr><td> + + <table class="invoice_header" width="100%"> + <tr> + <td><img src="<%= $cid ? "cid:$cid" : "cust_bill-logo.cgi?$template" %>"></td> + <td align="left"><%= $returnaddress %></td> + <td align="right"> + <table CLASS="invoice_headerright" cellspacing=0> + <tr> + <td align="right"> + Invoice date<BR> + <B><%= $date %></B> + </td> + <td> + </td> + <td align="left"> + Invoice number<BR> + <B><%= $invnum %></B> + </td> + </tr> + <tr> + <th> </th> + <th colspan=1 align="center"> + <FONT SIZE="+3">S</FONT><FONT SIZE="+2">TATEMENT</FONT> + </th> + <th> </th> + </tr> + </table> + </td> + </tr> + + <tr> + <td> + </td> + <td align="left"> + <b><%= $payname %></b><BR> + <%= join('<BR>', grep length($_), $company, + $address1, + $address2, + "$city, $state  $zip", + $country, + ) + %> + </td> + <td align="right"> + Terms: <%= $terms %><BR> + <%= $po_line %> + </td> + </tr> + + </table> + + <p><b><font size="+1">C</font><font size="+0">HARGES</font></b> + <p> + <table class="invoice_longtable" CELLSPACING=0 WIDTH="100%"> + <tr> + <th align="center">Ref</th> + <th align="left">Description</th> + <th align="right">Amount</th> + </tr> + <%= + + foreach my $line ( @detail_items ) { + $OUT .= + '<tr class="invoice_desc">'. + '<td align="center">'. $line->{'ref'}. '</td>'. + '<td align="left">'. $line->{'description'}. '</td>'. + '<td align="right">'. $line->{'amount'}. '</td>'. + '</tr>' + ; + foreach my $ext_desc ( @{$line->{'ext_description'} } ) { + $OUT .= + '<tr class="invoice_extdesc">'. + '<td></td>'. + '<td align="left">- '. $ext_desc. '</td>'. + '<td></td>'. + '</tr>' + } + } + + my $style = 'border-top: 3px solid #000000;'; + my $linenum = 0; + + foreach my $line ( @total_items ) { + + $style .= 'border-bottom: 3px solid #000000;' + if ++$linenum == scalar(@total_items); + + $OUT .= + '<tr class="invoice_totaldesc">'. + qq(<td style="$style"> </td>). + qq(<td align="left" style="$style">). + $line->{'total_item'}. '</td>'. + qq(<td align="right" style="$style">). + $line->{'total_amount'}. '</td>'. + '</tr>' + ; + + $style=''; + + } + + %> + </table> + <br><br> + +<%= $notes %> + + <hr NOSHADE SIZE=2 COLOR="#000000"> + <p align="center"><%= $footer %> + +</td></tr></table> diff --git a/conf/invoice_latex b/conf/invoice_latex new file mode 100644 index 000000000..6a81c4c2e --- /dev/null +++ b/conf/invoice_latex @@ -0,0 +1,260 @@ +%% file: Standard Multipage.tex +%% Purpose: Multipage bill template for e-Bills +%% +%% Created by Mark Asplen-Taylor +%% Asplen Management Ltd +%% www.asplen.co.uk +%% +%% Modified for Freeside by Kristian Hoffman +%% +%% Changes +%% 0.1 4/12/00 Created +%% 0.2 18/10/01 More fields added +%% 1.0 16/11/01 RELEASED +%% 1.2 16/10/02 Invoice number added +%% 1.3 2/12/02 Logo graphic added +%% 1.4 7/2/03 Multipage headers/footers added +%% n/a forked for Freeside; checked into CVS +%% + +\documentclass[letterpaper]{article} + +\usepackage{fancyhdr,lastpage,ifthen,longtable,afterpage} +\usepackage{graphicx} % required for logo graphic + +\addtolength{\voffset}{-0.0cm} % top margin to top of header +\addtolength{\hoffset}{-0.6cm} % left margin on page +\addtolength{\topmargin}{-1.25cm} % top margin to top of header +\setlength{\headheight}{2.0cm} % height of header +\setlength{\headsep}{1.0cm} % between header and text +\setlength{\footskip}{1.0cm} % bottom of footer from bottom of text + +%\addtolength{\textwidth}{2.1in} % width of text +\setlength{\textwidth}{19.5cm} +\setlength{\textheight}{19.5cm} +\setlength{\oddsidemargin}{-0.9cm} % odd page left margin +\setlength{\evensidemargin}{-0.9cm} % even page left margin + +\renewcommand{\headrulewidth}{0pt} +\renewcommand{\footrulewidth}{1pt} + +% Adjust the inset of the mailing address +\newcommand{\addressinset}[1][]{\hspace{1.0cm}} + +% Adjust the inset of the return address and logo +\newcommand{\returninset}[1][]{\hspace{-0.25cm}} + +% New command for address lines i.e. skip them if blank +\newcommand{\addressline}[1]{\ifthenelse{\equal{#1}{}}{}{#1\newline}} + +% Inserts dollar symbol +\newcommand{\dollar}[1][]{\symbol{36}} + +% Remove plain style header/footer +\fancypagestyle{plain}{ + \fancyhead{} +} +\fancyhf{} + +% Define fancy header/footer for first and subsequent pages +\fancyfoot[C]{ + \ifthenelse{\equal{\thepage}{1}} + { % First page + \small{ +[@-- $footer --@] + } + } + { % ... pages + \small{ +[@-- $smallfooter --@] + } + } +} + +\fancyfoot[R]{ + \ifthenelse{\equal{\thepage}{1}} + { % First page + } + { % ... pages + \small{\thepage\ of \pageref{LastPage}} + } +} + +\fancyhead[L]{ + \ifthenelse{\equal{\thepage}{1}} + { % First page + \returninset + \makebox{ + \begin{tabular}{ll} + \includegraphics{[@-- $logo_file --@]} & + \begin{minipage}[b]{5.5cm} +[@-- $returnaddress --@] + \end{minipage} + \end{tabular} + } + } + { % ... pages + %\includegraphics{[@-- $logo_file --@]} % Uncomment if you want the logo on all pages. + } +} + +\fancyhead[R]{ + \ifthenelse{\equal{\thepage}{1}} + { % First page + \begin{tabular}{ccc} + Invoice date & Invoice \#& Customer\#\\ + \vspace{0.2cm} + \textbf{[@-- $date --@]} & \textbf{[@-- $invnum --@]} & \textbf{[@-- $custnum --@]} \\\hline + \rule{0pt}{5ex} &~~ \huge{\textsc{Invoice}} & \\ + \vspace{-0.2cm} + & & \\\hline + \end{tabular} + } + { % ... pages + \small{ + \begin{tabular}{lll} + Invoice date & Invoice \#& Customer\#\\ + \textbf{[@-- $date --@]} & \textbf{[@-- $invnum --@]} & \textbf{[@-- $custnum --@]}\\ + \end{tabular} + } + } +} + +\pagestyle{fancy} + + +%% Font options are: +%% bch Bitsream Charter +%% put Utopia +%% phv Adobe Helvetica +%% pnc New Century Schoolbook +%% ptm Times +%% pcr Courier + +\renewcommand{\familydefault}{phv} + + +% Commands for freeside description... +\newcommand{\FSdesc}[3]{ + \multicolumn{1}{c}{\rule{0pt}{2.5ex}\textbf{#1}} & + \textbf{#2} & + \multicolumn{1}{r}{\textbf{\dollar #3}}\\ +} +% ...extended description... +\newcommand{\FSextdesc}[1]{ + \multicolumn{1}{l}{\rule{0pt}{1.0ex}} & + \multicolumn{2}{l}{\small{~-~#1}}\\ +} +% ...and total line items. +\newcommand{\FStotaldesc}[2]{ + & \multicolumn{1}{l}{#1} & #2\\ +} + + +\begin{document} +% +%% Headers and footers defined for the first page +% +%% The LH Heading comprising logo +%% UNCOMMENT the following FOUR lines and change the path if necssary to provide a logo +% +%% The Heading comprising isue date, customer ref & INVOICE name +% +%% Header & footer changes for subsequent pages +% +% +% +\begin{tabular}{ll} +\addressinset \rule{0cm}{0cm} & +\makebox{ +\begin{minipage}[t]{5.0cm} +\vspace{0.25cm} +\textbf{[@-- $payname --@]}\\ +\addressline{[@-- $company --@]} +\addressline{[@-- $address1 --@]} +\addressline{[@-- $address2 --@]} +\addressline{[@-- $city --@], [@-- $state --@]~~[@-- $zip --@]} +\addressline{[@-- $country --@]} +\end{minipage}} +\end{tabular} +\hfill +\makebox{ +\begin{minipage}[t]{6.4cm} +\begin{flushright} +Terms: [@-- $terms --@]\\ +[@-- $po_line --@]\\ +\end{flushright} +\end{minipage}} +\vspace{1.5cm} +% +[@-- + foreach my $section ( @sections ) { + $OUT .= '\section*{\textsc{'; + $OUT .= ($section->{'description'}) ? $section->{'description'} : 'Charges'; + $OUT .= '}}\begin{longtable}{clr}'; + $OUT .= '\hline'; + $OUT .= '\rule{0pt}{2.5ex}'; + $OUT .= '\makebox[1.4cm]{\textbf{Ref}} & '; + $OUT .= '\makebox[12.8cm][l]{\textbf{Description}} & '; + $OUT .= '\makebox[2.5cm][r]{\textbf{Amount}} \\\\'; + $OUT .= '\hline'; + $OUT .= '\endfirsthead'; + $OUT .= '\multicolumn{3}{r}{\rule{0pt}{2.5ex}Continued from previous page}\\\\'; + $OUT .= '\hline'; + $OUT .= '\rule{0pt}{2.5ex}'; + $OUT .= '\makebox[1.4cm]{\textbf{Ref}} & '; + $OUT .= '\makebox[12.8cm][l]{\textbf{Description}} & '; + $OUT .= '\makebox[2.5cm][r]{\textbf{Amount}} \\\\'; + $OUT .= '\hline'; + $OUT .= '\endhead'; + $OUT .= '\multicolumn{3}{r}{\rule{0pt}{2.5ex}Continued on next page...}\\\\'; + $OUT .= '\endfoot'; + $OUT .= '\hline'; + + if (scalar(@sections) > 1) { + $OUT .= '\FStotaldesc{' . $section->{'description'} . ' Total}' . + '{' . $section->{'subtotal'} . '}' . "\n"; + } + + if ($section == $sections[$#sections]) { + foreach my $line (@total_items) { + $OUT .= '\FStotaldesc{' . $line->{'total_item'} . '}' . + '{' . $line->{'total_amount'} . '}' . "\n"; + } + } + + $OUT .= '\hline'; + $OUT .= '\endlastfoot'; + + foreach my $line ( + grep { ( scalar( @sections ) > 1 + ? $section->{'description'} eq $_->{'section'}->{'description'} + : 1 + ) } + @detail_items ) + { + my $ext_description = $line->{'ext_description'}; + + # Don't break-up small packages. + my $rowbreak = @$ext_description < 5 ? '*' : ''; + + $OUT .= "\\hline\n"; + $OUT .= '\FSdesc{' . $line->{'ref'} . '}{' . $line->{'description'} . '}' . + '{' . $line->{'amount'} . "}${rowbreak}\n"; + + foreach my $ext_desc (@$ext_description) { + $ext_desc = substr($ext_desc, 0, 80) . '...' + if (length($ext_desc) > 80); + $OUT .= '\FSextdesc{' . $ext_desc . '}' . "${rowbreak}\n"; + } + + } + + $OUT .= '\end{longtable}'; + + } + +--@] +\vfill +[@-- $notes --@] +\end{document} diff --git a/conf/invoice_latex.diff b/conf/invoice_latex.diff new file mode 100644 index 000000000..b66a522f0 --- /dev/null +++ b/conf/invoice_latex.diff @@ -0,0 +1,138 @@ +--- invoice_latex.old 2005-04-14 01:52:02.000000000 -0700 ++++ invoice_latex 2005-04-14 02:33:26.000000000 -0700 +@@ -5,7 +5,7 @@ + %% Asplen Management Ltd + %% www.asplen.co.uk + %% +-%% Modified for Freeside by Ivan Kohler ++%% Modified for Freeside by Ivan Kohler and Kristian Hoffman + %% + %% Changes + %% 0.1 4/12/00 Created +@@ -61,7 +61,7 @@ + %% Headers and footers defined for the first page + \fancyfoot[CO,CE]{\small{ + \begin{tabular}{c} +-$footer ++[@-- $footer --@] + \end{tabular}}} + % + %% The LH Heading comprising logo +@@ -76,7 +76,7 @@ + \begin{tabular}{rcl} + Invoice date & & Invoice number \\ + \vspace{0.2cm} +-\textbf{$date} & & \textbf{$invnum} \\\hline ++\textbf{[@-- $date --@]} & & \textbf{[@-- $invnum --@]} \\\hline + \rule{0pt}{5ex} &~~ \huge{\textsc{Invoice}}& \\ + \vspace{-0.2cm} + & & \\\hline +@@ -85,71 +85,76 @@ + %% Header & footer changes for subsequent pages + % + \afterpage{ \fancyfoot[RO,RE]{\small{\thepage\ of \pageref{LastPage}}} } +-\afterpage{ \fancyfoot[CO,CE]{\small{$smallfooter}} } ++\afterpage{ \fancyfoot[CO,CE]{\small{[@-- $smallfooter --@]}} } + \afterpage{ \fancyhead[LO,LE]{\small{}} } + \afterpage{ \fancyhead[RO,RE]{\small{ + \begin{tabular}{ll} + Invoice date & Invoice number\\ +-\textbf{$date} & \textbf{$invnum}\\ ++\textbf{[@-- $date --@]} & \textbf{[@-- $invnum --@]}\\ + \end{tabular}}} } + % + % + \makebox{ + \begin{minipage}[t]{2.9in} + \vspace{0.20in} +-\textbf{$payname}\\ +-\addressline{$company} +-\addressline{$address1} +-\addressline{$address2} +-\addressline{$city, $state $zip} +-\addressline{$country} ++\textbf{[@-- $payname --@]}\\ ++\addressline{[@-- $company --@]} ++\addressline{[@-- $address1 --@]} ++\addressline{[@-- $address2 --@]} ++\addressline{[@-- $city --@], [@-- $state --@] [@-- $zip --@]} ++\addressline{[@-- $country --@]} + \end{minipage}} + \hfill + \makebox{ + \begin{minipage}[t]{2.5in} + \begin{flushright} +-Terms: $terms\\ +-$po_line\\ ++Terms: [@-- $terms --@]\\ ++[@-- $po_line --@]\\ + \end{flushright} + \end{minipage}} + \vspace{0.5cm} + % + \section*{\textsc{Charges}} +-\begin{longtable}{|c|l|c|r|r|} ++\begin{longtable}{|c|l|r|} + \hline + \rule{0pt}{2.5ex} + \makebox[1.4cm]{\textbf{Ref}} & +-\makebox[7.9cm][l]{\textbf{Description}} & +-\makebox[1.3cm][c]{\textbf{Quantity}} & +-\makebox[2.5cm][r]{\textbf{Unit Price}} & +-\makebox[2.5cm][r]{\textbf{Amount}} \\ ++\makebox[13cm][l]{\textbf{Description}} & ++\makebox[2cm][r]{\textbf{Amount}} \\ + \hline + \endfirsthead +-\multicolumn{5}{r}{\rule{0pt}{2.5ex}Continued from previous page}\\ ++\multicolumn{3}{r}{\rule{0pt}{2.5ex}Continued from previous page}\\ + \hline + \rule{0pt}{2.5ex} + \makebox[1.4cm]{\textbf{Ref}} & +-\makebox[7.9cm][l]{\textbf{Description}} & +-\makebox[1.3cm][c]{\textbf{Quantity}} & +-\makebox[2.5cm][r]{\textbf{Unit Price}} & +-\makebox[2.5cm][r]{\textbf{Amount}} \\ ++\makebox[13cm][l]{\textbf{Description}} & ++\makebox[2cm][r]{\textbf{Amount}} \\ + \hline + \endhead +-\multicolumn{5}{r}{\rule{0pt}{2.5ex}/cont...}\\ ++\multicolumn{3}{r}{\rule{0pt}{2.5ex}/cont...}\\ + \endfoot +-%%TotalDetails +- & \multicolumn{3}{l}{$total_item} & $total_amount\\ +-%%EndTotalDetails ++[@-- ++ ++ foreach my $line (@total_items) { ++ $OUT .= ' & \multicolumn{1}{l}{' . $line->{'total_item'} . '} & ' . ++ $line->{'total_amount'} . '\\\\' . "\n"; ++ } ++ ++--@] + \hline + \endlastfoot +-%%Detail +-\rule{0pt}{2.5ex}$ref & +-\begin{tabular}{l} +-$description\tabularnewline +-\end{tabular} +-& $quantity & \dollar $amount & \dollar $amount\\\hline +-%%EndDetail ++[@-- ++ ++ foreach my $line (@detail_items) { ++ $OUT .= '\rule{0pt}{2.5ex}' . $line->{'ref'} . ' &' . "\n". ++ '\begin{tabular}{l}' . "\n". ++ $line->{'description'} . '\tabularnewline' . "\n". ++ '\end{tabular}' . "\n". ++ '& \dollar ' . $line->{'amount'} . '\\\\\\hline' . "\n"; ++ } ++ ++--@] + \end{longtable} + \vfill +-$notes ++[@-- $notes --@] + \end{document} diff --git a/conf/invoice_latex_statement b/conf/invoice_latex_statement new file mode 100644 index 000000000..302306aa7 --- /dev/null +++ b/conf/invoice_latex_statement @@ -0,0 +1,244 @@ +%% file: Standard Multipage.tex +%% Purpose: Multipage bill template for e-Bills +%% +%% Created by Mark Asplen-Taylor +%% Asplen Management Ltd +%% www.asplen.co.uk +%% +%% Modified for Freeside by Kristian Hoffman +%% +%% Changes +%% 0.1 4/12/00 Created +%% 0.2 18/10/01 More fields added +%% 1.0 16/11/01 RELEASED +%% 1.2 16/10/02 Invoice number added +%% 1.3 2/12/02 Logo graphic added +%% 1.4 7/2/03 Multipage headers/footers added +%% n/a forked for Freeside; checked into CVS +%% + +\documentclass[letterpaper]{article} + +\usepackage{fancyhdr,lastpage,ifthen,longtable,afterpage} +\usepackage{graphicx} % required for logo graphic + +\addtolength{\voffset}{-0.0cm} % top margin to top of header +\addtolength{\hoffset}{-0.6cm} % left margin on page +\addtolength{\topmargin}{-1.25cm} % top margin to top of header +\setlength{\headheight}{2.0cm} % height of header +\setlength{\headsep}{1.0cm} % between header and text +\setlength{\footskip}{1.0cm} % bottom of footer from bottom of text + +%\addtolength{\textwidth}{2.1in} % width of text +\setlength{\textwidth}{19.5cm} +\setlength{\textheight}{19.5cm} +\setlength{\oddsidemargin}{-0.9cm} % odd page left margin +\setlength{\evensidemargin}{-0.9cm} % even page left margin + +\renewcommand{\headrulewidth}{0pt} +\renewcommand{\footrulewidth}{1pt} + +% Adjust the inset of the mailing address +\newcommand{\addressinset}[1][]{\hspace{1.0cm}} + +% Adjust the inset of the return address and logo +\newcommand{\returninset}[1][]{\hspace{-0.25cm}} + +% New command for address lines i.e. skip them if blank +\newcommand{\addressline}[1]{\ifthenelse{\equal{#1}{}}{}{#1\newline}} + +% Inserts dollar symbol +\newcommand{\dollar}[1][]{\symbol{36}} + +% Remove plain style header/footer +\fancypagestyle{plain}{ + \fancyhead{} +} +\fancyhf{} + +% Define fancy header/footer for first and subsequent pages +\fancyfoot[C]{ + \ifthenelse{\equal{\thepage}{1}} + { % First page + \small{ +[@-- $footer --@] + } + } + { % ... pages + \small{ +[@-- $smallfooter --@] + } + } +} + +\fancyfoot[R]{ + \ifthenelse{\equal{\thepage}{1}} + { % First page + } + { % ... pages + \small{\thepage\ of \pageref{LastPage}} + } +} + +\fancyhead[L]{ + \ifthenelse{\equal{\thepage}{1}} + { % First page + \returninset + \makebox{ + \begin{tabular}{ll} + \includegraphics{[@-- $conf_dir --@]/logo.eps} & + \begin{minipage}[b]{5.5cm} +[@-- $returnaddress --@] + \end{minipage} + \end{tabular} + } + } + { % ... pages + %\includegraphics{[@-- $conf_dir --@]/logo.eps} % Uncomment if you want the logo on all pages. + } +} + +\fancyhead[R]{ + \ifthenelse{\equal{\thepage}{1}} + { % First page + \begin{tabular}{rcl} + Invoice date & & Invoice number \\ + \vspace{0.2cm} + \textbf{[@-- $date --@]} & & \textbf{[@-- $invnum --@]} \\\hline + \rule{0pt}{5ex} &~~ \huge{\textsc{Statement}} & \\ + \vspace{-0.2cm} + & & \\\hline + \end{tabular} + } + { % ... pages + \small{ + \begin{tabular}{ll} + Invoice date & Invoice number\\ + \textbf{[@-- $date --@]} & \textbf{[@-- $invnum --@]}\\ + \end{tabular} + } + } +} + +\pagestyle{fancy} + + +%% Font options are: +%% bch Bitsream Charter +%% put Utopia +%% phv Adobe Helvetica +%% pnc New Century Schoolbook +%% ptm Times +%% pcr Courier + +\renewcommand{\familydefault}{phv} + + +% Commands for freeside description... +\newcommand{\FSdesc}[3]{ + \multicolumn{1}{c}{\rule{0pt}{2.5ex}\textbf{#1}} & + \textbf{#2} & + \multicolumn{1}{r}{\textbf{\dollar #3}}\\ +} +% ...extended description... +\newcommand{\FSextdesc}[1]{ + \multicolumn{1}{l}{\rule{0pt}{1.0ex}} & + \multicolumn{2}{l}{\small{~-~#1}}\\ +} +% ...and total line items. +\newcommand{\FStotaldesc}[2]{ + & \multicolumn{1}{l}{#1} & #2\\ +} + + +\begin{document} +% +%% Headers and footers defined for the first page +% +%% The LH Heading comprising logo +%% UNCOMMENT the following FOUR lines and change the path if necssary to provide a logo +% +%% The Heading comprising isue date, customer ref & INVOICE name +% +%% Header & footer changes for subsequent pages +% +% +% +\begin{tabular}{ll} +\addressinset \rule{0cm}{0cm} & +\makebox{ +\begin{minipage}[t]{5.0cm} +\vspace{0.25cm} +\textbf{[@-- $payname --@]}\\ +\addressline{[@-- $company --@]} +\addressline{[@-- $address1 --@]} +\addressline{[@-- $address2 --@]} +\addressline{[@-- $city --@], [@-- $state --@]~~[@-- $zip --@]} +\addressline{[@-- $country --@]} +\end{minipage}} +\end{tabular} +\hfill +\makebox{ +\begin{minipage}[t]{6.4cm} +\begin{flushright} +Terms: [@-- $terms --@]\\ +[@-- $po_line --@]\\ +\end{flushright} +\end{minipage}} +\vspace{1.5cm} +% +\section*{\textsc{Charges}} +\begin{longtable}{clr} +\hline +\rule{0pt}{2.5ex} +\makebox[1.4cm]{\textbf{Ref}} & +\makebox[12.8cm][l]{\textbf{Description}} & +\makebox[2.5cm][r]{\textbf{Amount}} \\ +\hline +\endfirsthead +\multicolumn{3}{r}{\rule{0pt}{2.5ex}Continued from previous page}\\ +\hline +\rule{0pt}{2.5ex} +\makebox[1.4cm]{\textbf{Ref}} & +\makebox[12.8cm][l]{\textbf{Description}} & +\makebox[2.5cm][r]{\textbf{Amount}} \\ +\hline +\endhead +\multicolumn{3}{r}{\rule{0pt}{2.5ex}Continued on next page...}\\ +\endfoot +\hline +[@-- + + foreach my $line (@total_items) { + $OUT .= '\FStotaldesc{' . $line->{'total_item'} . '}' . + '{' . $line->{'total_amount'} . '}' . "\n"; + } + +--@] +\hline +\endlastfoot +[@-- + + foreach my $line (@detail_items) { + my $ext_description = $line->{'ext_description'}; + + # Don't break-up small packages. + my $rowbreak = @$ext_description < 5 ? '*' : ''; + + $OUT .= "\\hline\n"; + $OUT .= '\FSdesc{' . $line->{'ref'} . '}{' . $line->{'description'} . '}' . + '{' . $line->{'amount'} . "}${rowbreak}\n"; + + foreach my $ext_desc (@$ext_description) { + $ext_desc = substr($ext_desc, 0, 80) . '...' + if (length($ext_desc) > 80); + $OUT .= '\FSextdesc{' . $ext_desc . '}' . "${rowbreak}\n"; + } + + } + +--@] +\end{longtable} +\vfill +[@-- $notes --@] +\end{document} diff --git a/conf/invoice_latexfooter b/conf/invoice_latexfooter new file mode 100644 index 000000000..2e32123f1 --- /dev/null +++ b/conf/invoice_latexfooter @@ -0,0 +1 @@ +[@-- $company_name --@] diff --git a/conf/invoice_latexnotes b/conf/invoice_latexnotes new file mode 100644 index 000000000..5303d3cc4 --- /dev/null +++ b/conf/invoice_latexnotes @@ -0,0 +1,8 @@ +%% +%% Add any customer specific notes in here +%% +\section*{\textsc{Notes}} +\begin{enumerate} +\item Please make your check payable to \textbf{[@-- $company_name --@]}. +\item If you have any questions please email or telephone. +\end{enumerate} diff --git a/conf/invoice_latexnotes_statement b/conf/invoice_latexnotes_statement new file mode 100644 index 000000000..0836d2745 --- /dev/null +++ b/conf/invoice_latexnotes_statement @@ -0,0 +1,8 @@ +%% +%% Add any customer specific notes in here +%% +\section*{\textsc{Notes}} +\begin{enumerate} +\item This statement reflects current charges and payments. +\item If you have any questions please email or telephone. +\end{enumerate} diff --git a/conf/invoice_latexsmallfooter b/conf/invoice_latexsmallfooter new file mode 100644 index 000000000..2e32123f1 --- /dev/null +++ b/conf/invoice_latexsmallfooter @@ -0,0 +1 @@ +[@-- $company_name --@] diff --git a/conf/invoice_template b/conf/invoice_template new file mode 100644 index 000000000..b33c4dda1 --- /dev/null +++ b/conf/invoice_template @@ -0,0 +1,26 @@ + + Invoice + { substr("Page $page of $total_pages ", 0, 19); } { use Date::Format; time2str("%x", $date); } Invoice #{ $invnum; } + + +{ $company_name; } +{ $company_address; } + + +{ $address[0]; } +{ $address[1]; } +{ $address[2]; } +{ $address[3]; } +{ $address[4]; } +{ $address[5]; } + +{ + join("\n", + map { + my ( $desc, $price ) = @{$_}; + " ". substr( $desc. " "x65, 0, 65). " ". substr( $price. " "x11, 0, 11); + } invoice_lines(31) + ); +} + + -=> { $company_name; } <=- diff --git a/conf/invoice_template_statement b/conf/invoice_template_statement new file mode 100644 index 000000000..db0291544 --- /dev/null +++ b/conf/invoice_template_statement @@ -0,0 +1,26 @@ + + Statement + { substr("Page $page of $total_pages ", 0, 19); } { use Date::Format; time2str("%x", $date); } Invoice #{ $invnum; } + + +{ $company_name; } +{ $company_address; } + + +{ $address[0]; } +{ $address[1]; } +{ $address[2]; } +{ $address[3]; } +{ $address[4]; } +{ $address[5]; } + +{ + join("\n", + map { + my ( $desc, $price ) = @{$_}; + " ". substr( $desc. " "x65, 0, 65). " ". substr( $price. " "x11, 0, 11); + } invoice_lines(31) + ); +} + + -=> { $company_name; } <=- diff --git a/conf/locale b/conf/locale new file mode 100644 index 000000000..7741b83a3 --- /dev/null +++ b/conf/locale @@ -0,0 +1 @@ +en_US diff --git a/conf/logo.eps b/conf/logo.eps new file mode 100644 index 000000000..ff25dd4ce --- /dev/null +++ b/conf/logo.eps @@ -0,0 +1,13510 @@ +%!PS-Adobe-2.0 EPSF-2.0 +%%HiResBoundingBox: 261.500000 345.500000 418.500000 446.500000 +%%Creator: xpdf/pdftops 3.00 +%%LanguageLevel: 2 +%%DocumentMedia: plain 612 792 0 () () +%%BoundingBox: 19 0 70 33 +%%EndComments +%%BeginProcSet: epsffit 1 0 +gsave +-65.000 -111.618 translate +0.324 0.324 scale +%%EndProcSet + +% EPSF created by ps2eps 1.54 +%%BeginProlog +save +countdictstack +mark +newpath +/showpage {} def +/setpagedevice {pop} def +%%EndProlog +%%Page 1 1 +/xpdf 75 dict def xpdf begin +% PDF special state +/pdfDictSize 15 def +/pdfSetup { + 3 1 roll 2 array astore + /setpagedevice where { + pop 3 dict begin + /PageSize exch def + /ImagingBBox null def + /Policies 1 dict dup begin /PageSize 3 def end def + { /Duplex true def } if + currentdict end setpagedevice + } { + pop pop + } ifelse +} def +/pdfStartPage { + pdfDictSize dict begin + /pdfFill [0] def + /pdfStroke [0] def + /pdfLastFill false def + /pdfLastStroke false def + /pdfTextMat [1 0 0 1 0 0] def + /pdfFontSize 0 def + /pdfCharSpacing 0 def + /pdfTextRender 0 def + /pdfTextRise 0 def + /pdfWordSpacing 0 def + /pdfHorizScaling 1 def + /pdfTextClipPath [] def +} def +/pdfEndPage { end } def +% separation convention operators +/findcmykcustomcolor where { + pop +}{ + /findcmykcustomcolor { 5 array astore } def +} ifelse +/setcustomcolor where { + pop +}{ + /setcustomcolor { + exch + [ exch /Separation exch dup 4 get exch /DeviceCMYK exch + 0 4 getinterval cvx + [ exch /dup load exch { mul exch dup } /forall load + /pop load dup ] cvx + ] setcolorspace setcolor + } def +} ifelse +/customcolorimage where { + pop +}{ + /customcolorimage { + gsave + [ exch /Separation exch dup 4 get exch /DeviceCMYK exch + 0 4 getinterval + [ exch /dup load exch { mul exch dup } /forall load + /pop load dup ] cvx + ] setcolorspace + 10 dict begin + /ImageType 1 def + /DataSource exch def + /ImageMatrix exch def + /BitsPerComponent exch def + /Height exch def + /Width exch def + /Decode [1 0] def + currentdict end + image + grestore + } def +} ifelse +% PDF color state +/sCol { + pdfLastStroke not { + pdfStroke aload length + dup 1 eq { + pop setgray + }{ + dup 3 eq { + pop setrgbcolor + }{ + 4 eq { + setcmykcolor + }{ + findcmykcustomcolor exch setcustomcolor + } ifelse + } ifelse + } ifelse + /pdfLastStroke true def /pdfLastFill false def + } if +} def +/fCol { + pdfLastFill not { + pdfFill aload length + dup 1 eq { + pop setgray + }{ + dup 3 eq { + pop setrgbcolor + }{ + 4 eq { + setcmykcolor + }{ + findcmykcustomcolor exch setcustomcolor + } ifelse + } ifelse + } ifelse + /pdfLastFill true def /pdfLastStroke false def + } if +} def +% build a font +/pdfMakeFont { + 4 3 roll findfont + 4 2 roll matrix scale makefont + dup length dict begin + { 1 index /FID ne { def } { pop pop } ifelse } forall + /Encoding exch def + currentdict + end + definefont pop +} def +/pdfMakeFont16 { + exch findfont + dup length dict begin + { 1 index /FID ne { def } { pop pop } ifelse } forall + /WMode exch def + currentdict + end + definefont pop +} def +/pdfMakeFont16L3 { + 1 index /CIDFont resourcestatus { + pop pop 1 index /CIDFont findresource /CIDFontType known + } { + false + } ifelse + { + 0 eq { /Identity-H } { /Identity-V } ifelse + exch 1 array astore composefont pop + } { + pdfMakeFont16 + } ifelse +} def +% graphics state operators +/q { gsave pdfDictSize dict begin } def +/Q { end grestore } def +/cm { concat } def +/d { setdash } def +/i { setflat } def +/j { setlinejoin } def +/J { setlinecap } def +/M { setmiterlimit } def +/w { setlinewidth } def +% color operators +/g { dup 1 array astore /pdfFill exch def setgray + /pdfLastFill true def /pdfLastStroke false def } def +/G { dup 1 array astore /pdfStroke exch def setgray + /pdfLastStroke true def /pdfLastFill false def } def +/rg { 3 copy 3 array astore /pdfFill exch def setrgbcolor + /pdfLastFill true def /pdfLastStroke false def } def +/RG { 3 copy 3 array astore /pdfStroke exch def setrgbcolor + /pdfLastStroke true def /pdfLastFill false def } def +/k { 4 copy 4 array astore /pdfFill exch def setcmykcolor + /pdfLastFill true def /pdfLastStroke false def } def +/K { 4 copy 4 array astore /pdfStroke exch def setcmykcolor + /pdfLastStroke true def /pdfLastFill false def } def +/ck { 6 copy 6 array astore /pdfFill exch def + findcmykcustomcolor exch setcustomcolor + /pdfLastFill true def /pdfLastStroke false def } def +/CK { 6 copy 6 array astore /pdfStroke exch def + findcmykcustomcolor exch setcustomcolor + /pdfLastStroke true def /pdfLastFill false def } def +% path segment operators +/m { moveto } def +/l { lineto } def +/c { curveto } def +/re { 4 2 roll moveto 1 index 0 rlineto 0 exch rlineto + neg 0 rlineto closepath } def +/h { closepath } def +% path painting operators +/S { sCol stroke } def +/Sf { fCol stroke } def +/f { fCol fill } def +/f* { fCol eofill } def +% clipping operators +/W { clip newpath } def +/W* { eoclip newpath } def +% text state operators +/Tc { /pdfCharSpacing exch def } def +/Tf { dup /pdfFontSize exch def + dup pdfHorizScaling mul exch matrix scale + pdfTextMat matrix concatmatrix dup 4 0 put dup 5 0 put + exch findfont exch makefont setfont } def +/Tr { /pdfTextRender exch def } def +/Ts { /pdfTextRise exch def } def +/Tw { /pdfWordSpacing exch def } def +/Tz { /pdfHorizScaling exch def } def +% text positioning operators +/Td { pdfTextMat transform moveto } def +/Tm { /pdfTextMat exch def } def +% text string operators +/cshow where { + pop + /cshow2 { + dup { + pop pop + 1 string dup 0 3 index put 3 index exec + } exch cshow + pop pop + } def +}{ + /cshow2 { + currentfont /FontType get 0 eq { + 0 2 2 index length 1 sub { + 2 copy get exch 1 add 2 index exch get + 2 copy exch 256 mul add + 2 string dup 0 6 5 roll put dup 1 5 4 roll put + 3 index exec + } for + } { + dup { + 1 string dup 0 3 index put 3 index exec + } forall + } ifelse + pop pop + } def +} ifelse +/awcp { + exch { + false charpath + 5 index 5 index rmoveto + 6 index eq { 7 index 7 index rmoveto } if + } exch cshow2 + 6 {pop} repeat +} def +/Tj { + fCol + 1 index stringwidth pdfTextMat idtransform pop + sub 1 index length dup 0 ne { div } { pop pop 0 } ifelse + pdfWordSpacing pdfHorizScaling mul 0 pdfTextMat dtransform 32 + 4 3 roll pdfCharSpacing pdfHorizScaling mul add 0 + pdfTextMat dtransform + 6 5 roll Tj1 +} def +/Tj16 { + fCol + 2 index stringwidth pdfTextMat idtransform pop + sub exch div + pdfWordSpacing pdfHorizScaling mul 0 pdfTextMat dtransform 32 + 4 3 roll pdfCharSpacing pdfHorizScaling mul add 0 + pdfTextMat dtransform + 6 5 roll Tj1 +} def +/Tj16V { + fCol + 2 index stringwidth pdfTextMat idtransform exch pop + sub exch div + 0 pdfWordSpacing pdfTextMat dtransform 32 + 4 3 roll pdfCharSpacing add 0 exch + pdfTextMat dtransform + 6 5 roll Tj1 +} def +/Tj1 { + 0 pdfTextRise pdfTextMat dtransform rmoveto + currentpoint 8 2 roll + pdfTextRender 1 and 0 eq { + 6 copy awidthshow + } if + pdfTextRender 3 and dup 1 eq exch 2 eq or { + 7 index 7 index moveto + 6 copy + currentfont /FontType get 3 eq { fCol } { sCol } ifelse + false awcp currentpoint stroke moveto + } if + pdfTextRender 4 and 0 ne { + 8 6 roll moveto + false awcp + /pdfTextClipPath [ pdfTextClipPath aload pop + {/moveto cvx} + {/lineto cvx} + {/curveto cvx} + {/closepath cvx} + pathforall ] def + currentpoint newpath moveto + } { + 8 {pop} repeat + } ifelse + 0 pdfTextRise neg pdfTextMat dtransform rmoveto +} def +/TJm { pdfFontSize 0.001 mul mul neg 0 + pdfTextMat dtransform rmoveto } def +/TJmV { pdfFontSize 0.001 mul mul neg 0 exch + pdfTextMat dtransform rmoveto } def +/Tclip { pdfTextClipPath cvx exec clip newpath + /pdfTextClipPath [] def } def +% Level 2 image operators +/pdfImBuf 100 string def +/pdfIm { + image + { currentfile pdfImBuf readline + not { pop exit } if + (%-EOD-) eq { exit } if } loop +} def +/pdfImSep { + findcmykcustomcolor exch + dup /Width get /pdfImBuf1 exch string def + dup /Decode get aload pop 1 index sub /pdfImDecodeRange exch def + /pdfImDecodeLow exch def + begin Width Height BitsPerComponent ImageMatrix DataSource end + /pdfImData exch def + { pdfImData pdfImBuf1 readstring pop + 0 1 2 index length 1 sub { + 1 index exch 2 copy get + pdfImDecodeRange mul 255 div pdfImDecodeLow add round cvi + 255 exch sub put + } for } + 6 5 roll customcolorimage + { currentfile pdfImBuf readline + not { pop exit } if + (%-EOD-) eq { exit } if } loop +} def +/pdfImM { + fCol imagemask + { currentfile pdfImBuf readline + not { pop exit } if + (%-EOD-) eq { exit } if } loop +} def +end +xpdf begin +/F2_0 /Helvetica 1 1 +[ /.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef + /.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef + /.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef + /.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef + /space/exclam/quotedbl/numbersign/dollar/percent/ampersand/quotesingle + /parenleft/parenright/asterisk/plus/comma/hyphen/period/slash + /zero/one/two/three/four/five/six/seven + /eight/nine/colon/semicolon/less/equal/greater/question + /at/A/B/C/D/E/F/G + /H/I/J/K/L/M/N/O + /P/Q/R/S/T/U/V/W + /X/Y/Z/bracketleft/backslash/bracketright/asciicircum/underscore + /grave/a/b/c/d/e/f/g + /h/i/j/k/l/m/n/o + /p/q/r/s/t/u/v/w + /x/y/z/braceleft/bar/braceright/asciitilde/bullet + /Euro/bullet/quotesinglbase/florin/quotedblbase/ellipsis/dagger/daggerdbl + /circumflex/perthousand/Scaron/guilsinglleft/OE/bullet/Zcaron/bullet + /bullet/quoteleft/quoteright/quotedblleft/quotedblright/bullet/endash/emdash + /tilde/trademark/scaron/guilsinglright/oe/bullet/zcaron/Ydieresis + /space/exclamdown/cent/sterling/currency/yen/brokenbar/section + /dieresis/copyright/ordfeminine/guillemotleft/logicalnot/hyphen/registered/macron + /degree/plusminus/twosuperior/threesuperior/acute/mu/paragraph/periodcentered + /cedilla/onesuperior/ordmasculine/guillemotright/onequarter/onehalf/threequarters/questiondown + /Agrave/Aacute/Acircumflex/Atilde/Adieresis/Aring/AE/Ccedilla + /Egrave/Eacute/Ecircumflex/Edieresis/Igrave/Iacute/Icircumflex/Idieresis + /Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis/multiply + /Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn/germandbls + /agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla + /egrave/eacute/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis + /eth/ntilde/ograve/oacute/ocircumflex/otilde/odieresis/divide + /oslash/ugrave/uacute/ucircumflex/udieresis/yacute/thorn/ydieresis] +pdfMakeFont +612 792 false pdfSetup +pdfStartPage +26.1663 -1.02141e-14 translate +0.9406 0.9406 scale +[] 0 d +1 i +0 j +0 J +10 M +1 w +0 g +0 G +q +[1 0 0 1 0 0] cm +[1 0 0 1 0 0] Tm +0 0 Td +0 g +328.715 366.945 10.4374 0.2006 re +f* +0 g +324.902 367.146 18.0648 0.2005 re +f* +0 g +322.292 367.346 23.2834 0.2006 re +f* +0 g +320.285 367.547 27.2978 0.2005 re +f* +0 g +318.278 367.747 31.3122 0.2006 re +f* +0 g +316.672 367.948 34.323 0.2006 re +f* +0 g +315.267 368.148 37.3338 0.2005 re +f* +0 g +313.862 368.349 39.9433 0.2005 re +f* +0 g +312.658 368.549 42.5525 0.2006 re +f* +0 g +311.453 368.75 44.9612 0.2006 re +f* +0 g +310.249 368.951 47.1691 0.2006 re +f* +0 g +309.245 369.151 49.377 0.2005 re +f* +0 g +308.242 369.352 50.5813 0.2005 re +f* +0 g +307.238 369.552 49.377 0.2006 re +f* +0 g +306.435 369.753 47.9719 0.2006 re +f* +0 g +305.432 369.953 47.3698 0.2006 re +f* +0 g +304.629 370.154 46.5669 0.2005 re +f* +0 g +303.826 370.355 46.1654 0.2006 re +f* +0 g +303.023 370.555 45.7641 0.2005 re +f* +1 g +348.787 370.555 13.8496 0.2005 re +f* +0.498 0 0.482 rg +362.637 370.555 2.2079 0.2005 re +f* +0 g +302.22 370.756 45.3626 0.2006 re +f* +1 g +347.583 370.756 13.8497 0.2006 re +f* +0.498 0 0.482 rg +361.433 370.756 4.2151 0.2006 re +f* +0 g +301.417 370.956 45.1618 0.2005 re +f* +1 g +346.579 370.956 13.6489 0.2005 re +f* +0.498 0 0.482 rg +360.228 370.956 6.2224 0.2005 re +f* +0 g +300.615 371.157 45.1619 0.2006 re +f* +1 g +345.776 371.157 13.4481 0.2006 re +f* +0.498 0 0.482 rg +359.225 371.157 7.8281 0.2006 re +f* +0 g +300.012 371.357 44.7605 0.2005 re +f* +1 g +344.773 371.357 13.4481 0.2005 re +f* +0.498 0 0.482 rg +358.221 371.357 9.6346 0.2005 re +f* +0 g +299.209 371.558 44.7604 0.2006 re +f* +1 g +343.97 371.558 13.2475 0.2006 re +f* +0.498 0 0.482 rg +357.217 371.558 11.2403 0.2006 re +f* +0 g +298.607 371.758 44.5597 0.2006 re +f* +1 g +343.167 371.758 13.0467 0.2006 re +f* +0.498 0 0.482 rg +356.214 371.758 13.0468 0.2006 re +f* +0 g +298.005 371.959 44.5597 0.2005 re +f* +1 g +342.565 371.959 12.8461 0.2005 re +f* +0.498 0 0.482 rg +355.411 371.959 14.4518 0.2005 re +f* +0 g +297.202 372.16 44.5597 0.2005 re +f* +1 g +341.762 372.16 12.846 0.2005 re +f* +0.498 0 0.482 rg +354.608 372.16 16.0576 0.2005 re +f* +0 g +296.6 372.36 44.5597 0.2006 re +f* +1 g +341.16 372.36 12.6454 0.2006 re +f* +0.498 0 0.482 rg +353.805 372.36 17.4625 0.2006 re +f* +0 g +295.998 372.561 44.359 0.2006 re +f* +1 g +340.357 372.561 12.6453 0.2006 re +f* +0.498 0 0.482 rg +353.002 372.561 18.8677 0.2006 re +f* +0 g +295.396 372.761 44.359 0.2006 re +f* +1 g +339.755 372.761 12.4446 0.2006 re +f* +0.498 0 0.482 rg +352.2 372.761 20.2726 0.2006 re +f* +0 g +294.794 372.962 44.359 0.2006 re +f* +1 g +339.153 372.962 12.2439 0.2006 re +f* +0.498 0 0.482 rg +351.397 372.962 21.6777 0.2006 re +f* +0 g +294.192 373.162 44.359 0.2005 re +f* +1 g +338.551 373.162 12.2439 0.2005 re +f* +0.498 0 0.482 rg +350.794 373.162 22.882 0.2005 re +f* +0 g +293.589 373.363 44.5597 0.2005 re +f* +1 g +338.149 373.363 11.8424 0.2005 re +f* +0.498 0 0.482 rg +349.991 373.363 24.2871 0.2005 re +f* +0 g +292.987 373.563 44.5598 0.2006 re +f* +1 g +337.547 373.563 11.8424 0.2006 re +f* +0.498 0 0.482 rg +349.389 373.563 25.4914 0.2006 re +f* +0 g +292.385 373.764 44.5597 0.2006 re +f* +1 g +336.945 373.764 11.8425 0.2006 re +f* +0.498 0 0.482 rg +348.787 373.764 26.6956 0.2006 re +f* +0 g +291.783 373.965 44.7605 0.2005 re +f* +1 g +336.543 373.965 11.6417 0.2005 re +f* +0.498 0 0.482 rg +348.185 373.965 27.6993 0.2005 re +f* +0 g +291.381 374.165 44.5597 0.2005 re +f* +1 g +335.941 374.165 11.6417 0.2005 re +f* +0.498 0 0.482 rg +347.583 374.165 28.9036 0.2005 re +f* +0 g +290.779 374.366 44.7605 0.2006 re +f* +1 g +335.54 374.366 11.4409 0.2006 re +f* +0.498 0 0.482 rg +346.981 374.366 30.108 0.2006 re +f* +0 g +290.378 374.566 44.5597 0.2006 re +f* +1 g +334.938 374.566 11.441 0.2006 re +f* +0.498 0 0.482 rg +346.379 374.566 31.1115 0.2006 re +f* +0 g +289.776 374.767 44.7605 0.2005 re +f* +1 g +334.536 374.767 11.4409 0.2005 re +f* +0.498 0 0.482 rg +345.977 374.767 32.1152 0.2005 re +f* +0 g +289.174 374.967 44.9611 0.2006 re +f* +1 g +334.135 374.967 11.2403 0.2006 re +f* +0.498 0 0.482 rg +345.375 374.967 33.1187 0.2006 re +f* +0 g +288.772 375.168 44.9612 0.2005 re +f* +1 g +333.733 375.168 11.0396 0.2005 re +f* +0.498 0 0.482 rg +344.773 375.168 34.323 0.2005 re +f* +0 g +288.371 375.368 44.9611 0.2006 re +f* +1 g +333.332 375.368 11.0396 0.2006 re +f* +0.498 0 0.482 rg +344.371 375.368 35.1259 0.2006 re +f* +0 g +287.768 375.569 45.1619 0.2006 re +f* +1 g +332.93 375.569 10.8389 0.2006 re +f* +0.498 0 0.482 rg +343.769 375.569 36.3302 0.2006 re +f* +0 g +287.367 375.77 45.1619 0.2006 re +f* +1 g +332.529 375.77 10.8388 0.2006 re +f* +0.498 0 0.482 rg +343.368 375.77 37.1331 0.2006 re +f* +0 g +286.765 375.97 45.3626 0.2005 re +f* +1 g +332.127 375.97 10.6382 0.2005 re +f* +0.498 0 0.482 rg +342.766 375.97 38.1367 0.2005 re +f* +0 g +286.363 376.171 45.3626 0.2005 re +f* +1 g +331.726 376.171 10.6381 0.2005 re +f* +0.498 0 0.482 rg +342.364 376.171 39.1403 0.2005 re +f* +0 g +285.962 376.371 45.3625 0.2006 re +f* +1 g +331.325 376.371 10.4375 0.2006 re +f* +0.498 0 0.482 rg +341.762 376.371 40.1439 0.2006 re +f* +0 g +285.561 376.572 45.3626 0.2006 re +f* +1 g +330.923 376.572 10.4374 0.2006 re +f* +0.498 0 0.482 rg +341.361 376.572 40.9468 0.2006 re +f* +0 g +284.958 376.772 45.5633 0.2005 re +f* +1 g +330.522 376.772 10.4374 0.2005 re +f* +0.498 0 0.482 rg +340.959 376.772 41.7496 0.2005 re +f* +0 g +284.557 376.973 45.7639 0.2006 re +f* +1 g +330.321 376.973 10.2368 0.2006 re +f* +0.498 0 0.482 rg +340.558 376.973 42.7532 0.2006 re +f* +0 g +284.156 377.173 45.764 0.2005 re +f* +1 g +329.92 377.173 10.2367 0.2005 re +f* +0.498 0 0.482 rg +340.156 377.173 43.5561 0.2005 re +f* +0 g +283.754 377.374 45.7641 0.2006 re +f* +1 g +329.518 377.374 10.2367 0.2006 re +f* +0.498 0 0.482 rg +339.755 377.374 44.3589 0.2006 re +f* +0 g +283.353 377.575 45.9648 0.2006 re +f* +1 g +329.317 377.575 10.0359 0.2006 re +f* +0.498 0 0.482 rg +339.353 377.575 45.1619 0.2006 re +f* +0 g +282.951 377.775 45.9647 0.2005 re +f* +1 g +328.916 377.775 10.036 0.2005 re +f* +0.498 0 0.482 rg +338.952 377.775 45.9647 0.2005 re +f* +0 g +282.55 377.976 45.9647 0.2006 re +f* +1 g +328.515 377.976 10.036 0.2006 re +f* +0.498 0 0.482 rg +338.551 377.976 46.7676 0.2006 re +f* +0 g +282.148 378.176 46.1655 0.2005 re +f* +1 g +328.314 378.176 9.8352 0.2005 re +f* +0.498 0 0.482 rg +338.149 378.176 47.5705 0.2005 re +f* +0 g +281.747 378.377 46.1655 0.2006 re +f* +1 g +327.912 378.377 9.8353 0.2006 re +f* +0.498 0 0.482 rg +337.748 378.377 48.3733 0.2006 re +f* +0 g +281.346 378.577 46.3662 0.2006 re +f* +1 g +327.712 378.577 9.6346 0.2006 re +f* +0.498 0 0.482 rg +337.346 378.577 49.1762 0.2006 re +f* +0 g +280.944 378.778 46.3662 0.2005 re +f* +1 g +327.31 378.778 9.6345 0.2005 re +f* +0.498 0 0.482 rg +336.945 378.778 49.9792 0.2005 re +f* +0 g +280.543 378.978 46.5668 0.2006 re +f* +1 g +327.11 378.978 9.4339 0.2006 re +f* +0.498 0 0.482 rg +336.543 378.978 50.7819 0.2006 re +f* +0 g +280.141 379.179 46.7676 0.2005 re +f* +1 g +326.909 379.179 9.4339 0.2005 re +f* +0.498 0 0.482 rg +336.343 379.179 51.3841 0.2005 re +f* +0 g +279.74 379.38 46.7677 0.2006 re +f* +1 g +326.507 379.38 9.4338 0.2006 re +f* +0.498 0 0.482 rg +335.941 379.38 52.187 0.2006 re +f* +0 g +279.338 379.58 46.9684 0.2006 re +f* +1 g +326.307 379.58 9.2331 0.2006 re +f* +0.498 0 0.482 rg +335.54 379.58 52.9899 0.2006 re +f* +0 g +278.937 379.781 46.9683 0.2005 re +f* +1 g +325.905 379.781 9.2331 0.2005 re +f* +0.498 0 0.482 rg +335.138 379.781 53.5921 0.2005 re +f* +0 g +278.736 379.981 46.9684 0.2006 re +f* +1 g +325.704 379.981 9.2331 0.2006 re +f* +0.498 0 0.482 rg +334.938 379.981 54.1942 0.2006 re +f* +0 g +278.335 380.182 47.1691 0.2005 re +f* +1 g +325.504 380.182 9.0324 0.2005 re +f* +0.498 0 0.482 rg +334.536 380.182 54.9971 0.2005 re +f* +0 g +277.933 380.382 47.3698 0.2006 re +f* +1 g +325.303 380.382 9.0323 0.2006 re +f* +0.498 0 0.482 rg +334.335 380.382 55.5994 0.2006 re +f* +0 g +277.532 380.583 47.3697 0.2005 re +f* +1 g +324.902 380.583 9.0324 0.2005 re +f* +0.498 0 0.482 rg +333.934 380.583 56.4022 0.2005 re +f* +0 g +277.331 380.783 47.3698 0.2006 re +f* +1 g +324.701 380.783 9.0324 0.2006 re +f* +0.498 0 0.482 rg +333.733 380.783 56.8036 0.2006 re +f* +0 g +287.367 380.984 37.1331 0.2006 re +f* +1 g +324.5 380.984 8.8316 0.2006 re +f* +0.498 0 0.482 rg +333.332 380.984 57.6066 0.2006 re +f* +0 g +287.367 381.185 36.9324 0.2005 re +f* +1 g +324.299 381.185 8.8316 0.2005 re +f* +0.498 0 0.482 rg +333.131 381.185 58.2087 0.2005 re +f* +0 g +287.367 381.385 36.5309 0.2006 re +f* +1 g +323.898 381.385 8.8317 0.2006 re +f* +0.498 0 0.482 rg +332.73 381.385 58.8108 0.2006 re +f* +0 g +287.367 381.586 36.3302 0.2005 re +f* +1 g +323.697 381.586 8.8317 0.2005 re +f* +0.498 0 0.482 rg +332.529 381.586 59.413 0.2005 re +f* +0 g +287.367 381.786 36.1295 0.2006 re +f* +1 g +323.497 381.786 8.6309 0.2006 re +f* +0.498 0 0.482 rg +332.127 381.786 60.2159 0.2006 re +f* +0 g +287.367 381.987 35.9288 0.2006 re +f* +1 g +323.296 381.987 8.6309 0.2006 re +f* +0.498 0 0.482 rg +331.927 381.987 60.6173 0.2006 re +f* +0 g +278.937 382.188 0.2007 0.2005 re +f* +1 g +279.138 382.188 8.2295 0.2005 re +f* +0 g +287.367 382.188 35.7281 0.2005 re +f* +1 g +323.095 382.188 8.4302 0.2005 re +f* +0.498 0 0.482 rg +331.525 382.188 61.4201 0.2005 re +f* +0 g +278.937 382.388 43.9575 0.2006 re +f* +1 g +322.894 382.388 8.4302 0.2006 re +f* +0.498 0 0.482 rg +331.325 382.388 61.8216 0.2006 re +f* +0 g +278.937 382.589 43.7569 0.2005 re +f* +1 g +322.694 382.589 8.4301 0.2005 re +f* +0.498 0 0.482 rg +331.124 382.589 62.4238 0.2005 re +f* +0 g +278.937 382.789 43.5561 0.2006 re +f* +1 g +322.493 382.789 8.2295 0.2006 re +f* +0.498 0 0.482 rg +330.722 382.789 63.2266 0.2006 re +f* +0 g +278.937 382.99 43.3554 0.2006 re +f* +1 g +322.292 382.99 8.2295 0.2006 re +f* +0.498 0 0.482 rg +330.522 382.99 63.628 0.2006 re +f* +0 g +278.937 383.19 43.1547 0.2005 re +f* +1 g +322.092 383.19 8.2294 0.2005 re +f* +0.498 0 0.482 rg +330.321 383.19 64.2303 0.2005 re +f* +0 g +278.937 383.391 42.9539 0.2006 re +f* +1 g +321.891 383.391 8.2295 0.2006 re +f* +0.498 0 0.482 rg +330.12 383.391 64.6317 0.2006 re +f* +0 g +278.937 383.591 42.7533 0.2005 re +f* +1 g +321.69 383.591 8.0287 0.2005 re +f* +0.498 0 0.482 rg +329.719 383.591 65.4345 0.2005 re +f* +0 g +278.937 383.792 42.5525 0.2006 re +f* +1 g +321.489 383.792 8.0288 0.2006 re +f* +0.498 0 0.482 rg +329.518 383.792 65.8359 0.2006 re +f* +0 g +278.937 383.992 42.3518 0.2006 re +f* +1 g +321.289 383.992 8.0288 0.2006 re +f* +0.498 0 0.482 rg +329.317 383.992 66.4381 0.2006 re +f* +0 g +278.937 384.193 42.1511 0.2005 re +f* +1 g +321.088 384.193 8.0287 0.2005 re +f* +0.498 0 0.482 rg +329.117 384.193 66.8396 0.2005 re +f* +0 g +278.937 384.394 41.9503 0.2005 re +f* +1 g +320.887 384.394 8.0288 0.2005 re +f* +0.498 0 0.482 rg +328.916 384.394 67.241 0.2005 re +f* +0 g +278.937 384.594 41.7497 0.2006 re +f* +1 g +320.687 384.594 7.828 0.2006 re +f* +0.498 0 0.482 rg +328.515 384.594 68.0439 0.2006 re +f* +0 g +271.109 384.795 0.2008 0.2006 re +f* +1 g +271.31 384.795 7.6273 0.2006 re +f* +0 g +278.937 384.795 41.5489 0.2006 re +f* +1 g +320.486 384.795 7.8281 0.2006 re +f* +0.498 0 0.482 rg +328.314 384.795 68.4453 0.2006 re +f* +0 g +270.707 384.995 0.6022 0.2006 re +f* +1 g +271.31 384.995 7.6273 0.2006 re +f* +0 g +278.937 384.995 41.3482 0.2006 re +f* +1 g +320.285 384.995 7.828 0.2006 re +f* +0.498 0 0.482 rg +328.113 384.995 69.0475 0.2006 re +f* +0 g +270.507 385.196 0.8029 0.2005 re +f* +1 g +271.31 385.196 7.6273 0.2005 re +f* +0 g +278.937 385.196 41.1475 0.2005 re +f* +1 g +320.084 385.196 7.828 0.2005 re +f* +0.498 0 0.482 rg +327.912 385.196 69.4489 0.2005 re +f* +0 g +270.306 385.396 1.0036 0.2006 re +f* +1 g +271.31 385.396 7.6273 0.2006 re +f* +0 g +278.937 385.396 40.9467 0.2006 re +f* +1 g +319.884 385.396 7.8281 0.2006 re +f* +0.498 0 0.482 rg +327.712 385.396 69.8504 0.2006 re +f* +0 g +269.904 385.597 1.4051 0.2005 re +f* +1 g +271.31 385.597 7.6273 0.2005 re +f* +0 g +278.937 385.597 40.7461 0.2005 re +f* +1 g +319.683 385.597 7.828 0.2005 re +f* +0.498 0 0.482 rg +327.511 385.597 70.4525 0.2005 re +f* +0 g +269.704 385.797 1.6058 0.2006 re +f* +1 g +271.31 385.797 7.6273 0.2006 re +f* +0 g +278.937 385.797 40.7461 0.2006 re +f* +1 g +319.683 385.797 7.6273 0.2006 re +f* +0.498 0 0.482 rg +327.31 385.797 70.8539 0.2006 re +f* +0 g +269.503 385.998 1.8065 0.2005 re +f* +1 g +271.31 385.998 7.6273 0.2005 re +f* +0 g +278.937 385.998 40.5453 0.2005 re +f* +1 g +319.482 385.998 7.6273 0.2005 re +f* +0.498 0 0.482 rg +327.11 385.998 71.2554 0.2005 re +f* +0 g +269.102 386.199 2.208 0.2006 re +f* +1 g +271.31 386.199 7.6273 0.2006 re +f* +0 g +278.937 386.199 40.3446 0.2006 re +f* +1 g +319.281 386.199 7.6273 0.2006 re +f* +0.498 0 0.482 rg +326.909 386.199 71.8576 0.2006 re +f* +0 g +268.901 386.399 2.4087 0.2005 re +f* +1 g +271.31 386.399 7.6273 0.2005 re +f* +0 g +278.937 386.399 40.1438 0.2005 re +f* +1 g +319.081 386.399 7.6274 0.2005 re +f* +0.498 0 0.482 rg +326.708 386.399 72.259 0.2005 re +f* +0 g +268.7 386.6 2.6094 0.2006 re +f* +1 g +271.31 386.6 7.6273 0.2006 re +f* +0 g +278.937 386.6 39.9431 0.2006 re +f* +1 g +318.88 386.6 7.6274 0.2006 re +f* +0.498 0 0.482 rg +326.507 386.6 72.6604 0.2006 re +f* +0 g +268.299 386.8 3.0108 0.2006 re +f* +1 g +271.31 386.8 7.6273 0.2006 re +f* +0 g +278.937 386.8 39.9431 0.2006 re +f* +1 g +318.88 386.8 7.4267 0.2006 re +f* +0.498 0 0.482 rg +326.307 386.8 73.0618 0.2006 re +f* +0 g +268.098 387.001 3.2115 0.2005 re +f* +1 g +271.31 387.001 7.6273 0.2005 re +f* +0 g +278.937 387.001 39.7425 0.2005 re +f* +1 g +318.679 387.001 7.4265 0.2005 re +f* +0.498 0 0.482 rg +326.106 387.001 73.6641 0.2005 re +f* +0 g +267.897 387.201 3.4123 0.2005 re +f* +1 g +271.31 387.201 7.6273 0.2005 re +f* +0 g +278.937 387.201 39.5417 0.2005 re +f* +1 g +318.479 387.201 7.4266 0.2005 re +f* +0.498 0 0.482 rg +325.905 387.201 74.0655 0.2005 re +f* +0 g +267.697 387.402 3.613 0.2006 re +f* +1 g +271.31 387.402 7.6273 0.2006 re +f* +0 g +278.937 387.402 39.341 0.2006 re +f* +1 g +318.278 387.402 7.4266 0.2006 re +f* +0.498 0 0.482 rg +325.704 387.402 74.4669 0.2006 re +f* +0 g +267.295 387.603 4.0144 0.2006 re +f* +1 g +271.31 387.603 7.6273 0.2006 re +f* +0 g +278.937 387.603 39.341 0.2006 re +f* +1 g +318.278 387.603 7.2259 0.2006 re +f* +0.498 0 0.482 rg +325.504 387.603 74.8683 0.2006 re +f* +0 g +267.094 387.803 4.2151 0.2006 re +f* +1 g +271.31 387.803 7.6273 0.2006 re +f* +0 g +278.937 387.803 39.1402 0.2006 re +f* +1 g +318.077 387.803 7.226 0.2006 re +f* +0.498 0 0.482 rg +325.303 387.803 75.4705 0.2006 re +f* +0 g +266.894 388.004 4.4159 0.2006 re +f* +1 g +271.31 388.004 7.6273 0.2006 re +f* +0 g +278.937 388.004 38.9395 0.2006 re +f* +1 g +317.876 388.004 7.226 0.2006 re +f* +0.498 0 0.482 rg +325.102 388.004 75.8719 0.2006 re +f* +0 g +266.693 388.204 4.6166 0.2005 re +f* +1 g +271.31 388.204 7.6273 0.2005 re +f* +0 g +278.937 388.204 38.7389 0.2005 re +f* +1 g +317.676 388.204 7.2258 0.2005 re +f* +0.498 0 0.482 rg +324.902 388.204 76.2734 0.2005 re +f* +0 g +266.492 388.405 4.8173 0.2005 re +f* +1 g +271.31 388.405 7.6273 0.2005 re +f* +0 g +278.937 388.405 38.7389 0.2005 re +f* +1 g +317.676 388.405 7.0251 0.2005 re +f* +0.498 0 0.482 rg +324.701 388.405 76.6748 0.2005 re +f* +0 g +266.292 388.605 5.018 0.2006 re +f* +1 g +271.31 388.605 7.6273 0.2006 re +f* +0 g +278.937 388.605 38.5381 0.2006 re +f* +1 g +317.475 388.605 7.0252 0.2006 re +f* +0.498 0 0.482 rg +324.5 388.605 77.0762 0.2006 re +f* +0 g +265.89 388.806 5.4195 0.2006 re +f* +1 g +271.31 388.806 7.6273 0.2006 re +f* +0 g +278.937 388.806 38.3374 0.2006 re +f* +1 g +317.274 388.806 7.0252 0.2006 re +f* +0.498 0 0.482 rg +324.299 388.806 77.4777 0.2006 re +f* +0 g +265.689 389.006 5.6202 0.2005 re +f* +1 g +271.31 389.006 7.6273 0.2005 re +f* +0 g +278.937 389.006 38.3374 0.2005 re +f* +1 g +317.274 389.006 7.0252 0.2005 re +f* +0.498 0 0.482 rg +324.299 389.006 77.8791 0.2005 re +f* +0 g +265.489 389.207 5.8209 0.2005 re +f* +1 g +271.31 389.207 7.6273 0.2005 re +f* +0 g +278.937 389.207 38.1367 0.2005 re +f* +1 g +317.074 389.207 7.0252 0.2005 re +f* +0.498 0 0.482 rg +324.099 389.207 78.2805 0.2005 re +f* +0 g +265.288 389.407 6.0216 0.2006 re +f* +1 g +271.31 389.407 7.6273 0.2006 re +f* +0 g +278.937 389.407 37.9359 0.2006 re +f* +1 g +316.873 389.407 7.0252 0.2006 re +f* +0.498 0 0.482 rg +323.898 389.407 78.682 0.2006 re +f* +0 g +265.087 389.608 6.2224 0.2006 re +f* +1 g +271.31 389.608 7.6273 0.2006 re +f* +0 g +278.937 389.608 37.9359 0.2006 re +f* +1 g +316.873 389.608 6.8245 0.2006 re +f* +0.498 0 0.482 rg +323.697 389.608 79.0835 0.2006 re +f* +0 g +264.886 389.809 6.4231 0.2005 re +f* +1 g +271.31 389.809 7.6273 0.2005 re +f* +0 g +278.937 389.809 37.7352 0.2005 re +f* +1 g +316.672 389.809 6.8245 0.2005 re +f* +0.498 0 0.482 rg +323.497 389.809 79.4849 0.2005 re +f* +0 g +264.686 390.009 6.6238 0.2006 re +f* +1 g +271.31 390.009 7.6273 0.2006 re +f* +0 g +278.937 390.009 37.5345 0.2006 re +f* +1 g +316.471 390.009 7.0252 0.2006 re +f* +0.498 0 0.482 rg +323.497 390.009 79.6856 0.2006 re +f* +0 g +264.485 390.21 6.8245 0.2005 re +f* +1 g +271.31 390.21 7.6273 0.2005 re +f* +0 g +278.937 390.21 37.5345 0.2005 re +f* +1 g +316.471 390.21 6.8245 0.2005 re +f* +0.498 0 0.482 rg +323.296 390.21 80.087 0.2005 re +f* +0 g +264.284 390.41 7.0252 0.2006 re +f* +1 g +271.31 390.41 7.6273 0.2006 re +f* +0 g +278.937 390.41 37.3338 0.2006 re +f* +1 g +316.271 390.41 6.8245 0.2006 re +f* +0.498 0 0.482 rg +323.095 390.41 80.4884 0.2006 re +f* +0 g +264.084 390.611 7.226 0.2006 re +f* +1 g +271.31 390.611 7.6273 0.2006 re +f* +0 g +278.937 390.611 37.1331 0.2006 re +f* +1 g +316.07 390.611 6.8244 0.2006 re +f* +0.498 0 0.482 rg +322.894 390.611 80.89 0.2006 re +f* +0 g +263.883 390.811 7.4267 0.2006 re +f* +1 g +271.31 390.811 7.6273 0.2006 re +f* +0 g +278.937 390.811 37.1331 0.2006 re +f* +1 g +316.07 390.811 6.8244 0.2006 re +f* +0.498 0 0.482 rg +322.894 390.811 81.0907 0.2006 re +f* +0 g +263.682 391.012 7.6274 0.2005 re +f* +1 g +271.31 391.012 7.6273 0.2005 re +f* +0 g +278.937 391.012 36.9323 0.2005 re +f* +1 g +315.869 391.012 6.8246 0.2005 re +f* +0.498 0 0.482 rg +322.694 391.012 81.492 0.2005 re +f* +0 g +263.281 391.213 8.0288 0.2005 re +f* +1 g +271.31 391.213 7.6273 0.2005 re +f* +0 g +278.937 391.213 36.9323 0.2005 re +f* +1 g +315.869 391.213 6.6238 0.2005 re +f* +0.498 0 0.482 rg +322.493 391.213 81.8935 0.2005 re +f* +0 g +263.08 391.413 8.2296 0.2006 re +f* +1 g +271.31 391.413 7.6273 0.2006 re +f* +0 g +278.937 391.413 36.7317 0.2006 re +f* +1 g +315.669 391.413 6.6237 0.2006 re +f* +0.498 0 0.482 rg +322.292 391.413 82.2949 0.2006 re +f* +0 g +262.879 391.614 8.4303 0.2006 re +f* +1 g +271.31 391.614 7.6273 0.2006 re +f* +0 g +278.937 391.614 36.5309 0.2006 re +f* +1 g +315.468 391.614 6.8245 0.2006 re +f* +0.498 0 0.482 rg +322.292 391.614 82.4957 0.2006 re +f* +0 g +262.679 391.814 8.631 0.2005 re +f* +1 g +271.31 391.814 7.6273 0.2005 re +f* +0 g +278.937 391.814 36.5309 0.2005 re +f* +1 g +315.468 391.814 6.6238 0.2005 re +f* +0.498 0 0.482 rg +322.092 391.814 82.8971 0.2005 re +f* +0 g +262.478 392.015 8.8317 0.2006 re +f* +1 g +271.31 392.015 7.6273 0.2006 re +f* +0 g +278.937 392.015 36.3302 0.2006 re +f* +1 g +315.267 392.015 6.6237 0.2006 re +f* +0.498 0 0.482 rg +321.891 392.015 83.2986 0.2006 re +f* +0 g +262.277 392.215 9.0324 0.2005 re +f* +1 g +271.31 392.215 7.6273 0.2005 re +f* +0 g +278.937 392.215 36.3302 0.2005 re +f* +1 g +315.267 392.215 6.6237 0.2005 re +f* +0.498 0 0.482 rg +321.891 392.215 83.4993 0.2005 re +f* +0 g +262.277 392.416 9.0324 0.2006 re +f* +1 g +271.31 392.416 7.6273 0.2006 re +f* +0 g +278.937 392.416 36.1295 0.2006 re +f* +1 g +315.066 392.416 6.6238 0.2006 re +f* +0.498 0 0.482 rg +321.69 392.416 83.9007 0.2006 re +f* +0 g +262.076 392.616 9.2332 0.2006 re +f* +1 g +271.31 392.616 7.6273 0.2006 re +f* +0 g +278.937 392.616 36.1295 0.2006 re +f* +1 g +315.066 392.616 6.423 0.2006 re +f* +0.498 0 0.482 rg +321.489 392.616 84.3022 0.2006 re +f* +0 g +261.876 392.817 9.4339 0.2005 re +f* +1 g +271.31 392.817 7.6273 0.2005 re +f* +0 g +278.937 392.817 35.9287 0.2005 re +f* +1 g +314.866 392.817 6.6238 0.2005 re +f* +0.498 0 0.482 rg +321.489 392.817 84.5029 0.2005 re +f* +0 g +261.675 393.018 9.6346 0.2006 re +f* +1 g +271.31 393.018 7.6273 0.2006 re +f* +0 g +278.937 393.018 35.9287 0.2006 re +f* +1 g +314.866 393.018 6.4231 0.2006 re +f* +0.498 0 0.482 rg +321.289 393.018 84.9043 0.2006 re +f* +0 g +261.474 393.218 9.8353 0.2005 re +f* +1 g +271.31 393.218 7.6273 0.2005 re +f* +0 g +278.937 393.218 35.7281 0.2005 re +f* +1 g +314.665 393.218 6.423 0.2005 re +f* +0.498 0 0.482 rg +321.088 393.218 85.3057 0.2005 re +f* +0 g +261.274 393.419 10.036 0.2006 re +f* +1 g +271.31 393.419 7.6273 0.2006 re +f* +0 g +278.937 393.419 35.7281 0.2006 re +f* +1 g +314.665 393.419 6.423 0.2006 re +f* +0.498 0 0.482 rg +321.088 393.419 85.5064 0.2006 re +f* +0 g +261.073 393.619 10.2368 0.2006 re +f* +1 g +271.31 393.619 7.6273 0.2006 re +f* +0 g +278.937 393.619 35.5273 0.2006 re +f* +1 g +314.464 393.619 6.423 0.2006 re +f* +0.498 0 0.482 rg +320.887 393.619 85.908 0.2006 re +f* +0 g +260.872 393.82 10.4375 0.2005 re +f* +1 g +271.31 393.82 7.6273 0.2005 re +f* +0 g +278.937 393.82 35.5273 0.2005 re +f* +1 g +314.464 393.82 6.423 0.2005 re +f* +0.498 0 0.482 rg +320.887 393.82 86.1087 0.2005 re +f* +0 g +260.671 394.02 10.6382 0.2006 re +f* +1 g +271.31 394.02 7.6273 0.2006 re +f* +0 g +278.937 394.02 35.3266 0.2006 re +f* +1 g +314.263 394.02 6.4231 0.2006 re +f* +0.498 0 0.482 rg +320.687 394.02 86.51 0.2006 re +f* +0 g +260.471 394.221 10.8389 0.2005 re +f* +1 g +271.31 394.221 7.6273 0.2005 re +f* +0 g +278.937 394.221 35.3266 0.2005 re +f* +1 g +314.263 394.221 6.2223 0.2005 re +f* +0.498 0 0.482 rg +320.486 394.221 86.9115 0.2005 re +f* +0 g +260.27 394.421 11.0396 0.2006 re +f* +1 g +271.31 394.421 7.6273 0.2006 re +f* +0 g +278.937 394.421 35.1259 0.2006 re +f* +1 g +314.063 394.421 6.423 0.2006 re +f* +0.498 0 0.482 rg +320.486 394.421 86.9115 0.2006 re +f* +0 g +260.27 394.622 11.0396 0.2006 re +f* +1 g +271.31 394.622 7.6273 0.2006 re +f* +0 g +278.937 394.622 35.1259 0.2006 re +f* +1 g +314.063 394.622 6.2223 0.2006 re +f* +0.498 0 0.482 rg +320.285 394.622 87.3129 0.2006 re +f* +0 g +260.069 394.823 11.2403 0.2005 re +f* +1 g +271.31 394.823 7.6273 0.2005 re +f* +0 g +278.937 394.823 34.9251 0.2005 re +f* +1 g +313.862 394.823 6.4231 0.2005 re +f* +0.498 0 0.482 rg +320.285 394.823 87.5137 0.2005 re +f* +0 g +259.868 395.023 11.4411 0.2006 re +f* +1 g +271.31 395.023 7.6273 0.2006 re +f* +0 g +278.937 395.023 34.9251 0.2006 re +f* +1 g +313.862 395.023 6.2224 0.2006 re +f* +0.498 0 0.482 rg +320.084 395.023 87.9151 0.2006 re +f* +0 g +259.668 395.224 11.6418 0.2005 re +f* +1 g +271.31 395.224 7.6273 0.2005 re +f* +0 g +278.937 395.224 34.7245 0.2005 re +f* +1 g +313.661 395.224 6.423 0.2005 re +f* +0.498 0 0.482 rg +320.084 395.224 88.1158 0.2005 re +f* +0 g +259.467 395.424 11.8425 0.2006 re +f* +1 g +271.31 395.424 7.6273 0.2006 re +f* +0 g +278.937 395.424 34.7245 0.2006 re +f* +1 g +313.661 395.424 6.2222 0.2006 re +f* +0.498 0 0.482 rg +319.884 395.424 88.5173 0.2006 re +f* +0 g +259.266 395.625 12.0432 0.2005 re +f* +1 g +271.31 395.625 7.6273 0.2005 re +f* +0 g +278.937 395.625 34.5237 0.2005 re +f* +1 g +313.461 395.625 6.423 0.2005 re +f* +0.498 0 0.482 rg +319.884 395.625 88.5173 0.2005 re +f* +0 g +259.266 395.825 12.0432 0.2006 re +f* +1 g +271.31 395.825 7.6273 0.2006 re +f* +0 g +278.937 395.825 34.5237 0.2006 re +f* +1 g +313.461 395.825 6.2224 0.2006 re +f* +0.498 0 0.482 rg +319.683 395.825 88.9186 0.2006 re +f* +0 g +259.066 396.026 12.2439 0.2006 re +f* +1 g +271.31 396.026 7.6273 0.2006 re +f* +0 g +278.937 396.026 34.5237 0.2006 re +f* +1 g +313.461 396.026 6.2224 0.2006 re +f* +0.498 0 0.482 rg +319.683 396.026 89.1194 0.2006 re +f* +0 g +258.865 396.227 12.4447 0.2005 re +f* +1 g +271.31 396.227 7.6273 0.2005 re +f* +0 g +278.937 396.227 34.323 0.2005 re +f* +1 g +313.26 396.227 6.2223 0.2005 re +f* +0.498 0 0.482 rg +319.482 396.227 89.5209 0.2005 re +f* +0 g +258.664 396.427 12.6454 0.2006 re +f* +1 g +271.31 396.427 7.6273 0.2006 re +f* +0 g +278.937 396.427 34.323 0.2006 re +f* +1 g +313.26 396.427 6.2223 0.2006 re +f* +0.498 0 0.482 rg +319.482 396.427 89.7216 0.2006 re +f* +0 g +258.463 396.628 12.8461 0.2005 re +f* +1 g +271.31 396.628 7.6273 0.2005 re +f* +0 g +278.937 396.628 34.1223 0.2005 re +f* +1 g +313.059 396.628 6.2223 0.2005 re +f* +0.498 0 0.482 rg +319.281 396.628 89.9223 0.2005 re +f* +0 g +258.463 396.828 12.8461 0.2006 re +f* +1 g +271.31 396.828 7.6273 0.2006 re +f* +0 g +278.937 396.828 34.1223 0.2006 re +f* +1 g +313.059 396.828 6.2223 0.2006 re +f* +0.498 0 0.482 rg +319.281 396.828 90.123 0.2006 re +f* +0 g +258.263 397.029 13.0468 0.2006 re +f* +1 g +271.31 397.029 7.6273 0.2006 re +f* +0 g +278.937 397.029 34.1223 0.2006 re +f* +1 g +313.059 397.029 6.0215 0.2006 re +f* +0.498 0 0.482 rg +319.081 397.029 90.5245 0.2006 re +f* +0 g +258.062 397.229 13.2475 0.2005 re +f* +1 g +271.31 397.229 7.6273 0.2005 re +f* +0 g +278.937 397.229 33.9216 0.2005 re +f* +1 g +312.858 397.229 6.2222 0.2005 re +f* +0.498 0 0.482 rg +319.081 397.229 90.7253 0.2005 re +f* +0 g +258.062 397.43 13.2475 0.2006 re +f* +1 g +271.31 397.43 7.6273 0.2006 re +f* +0 g +278.937 397.43 33.9216 0.2006 re +f* +1 g +312.858 397.43 6.0215 0.2006 re +f* +0.498 0 0.482 rg +318.88 397.43 90.926 0.2006 re +f* +0 g +257.861 397.63 13.4483 0.2005 re +f* +1 g +271.31 397.63 7.6273 0.2005 re +f* +0 g +278.937 397.63 33.7209 0.2005 re +f* +1 g +312.658 397.63 6.2222 0.2005 re +f* +0.498 0 0.482 rg +318.88 397.63 91.1267 0.2005 re +f* +0 g +257.661 397.831 13.649 0.2006 re +f* +1 g +271.31 397.831 7.6273 0.2006 re +f* +0 g +278.937 397.831 33.7209 0.2006 re +f* +1 g +312.658 397.831 6.2222 0.2006 re +f* +0.498 0 0.482 rg +318.88 397.831 91.3274 0.2006 re +f* +0 g +257.46 398.032 13.8497 0.2006 re +f* +1 g +271.31 398.032 7.6273 0.2006 re +f* +0 g +278.937 398.032 33.7209 0.2006 re +f* +1 g +312.658 398.032 6.0216 0.2006 re +f* +0.498 0 0.482 rg +318.679 398.032 91.7287 0.2006 re +f* +0 g +257.46 398.232 13.8497 0.2005 re +f* +1 g +271.31 398.232 7.6273 0.2005 re +f* +0 g +278.937 398.232 33.5201 0.2005 re +f* +1 g +312.457 398.232 6.2224 0.2005 re +f* +0.498 0 0.482 rg +318.679 398.232 91.7287 0.2005 re +f* +0 g +257.259 398.433 14.0504 0.2006 re +f* +1 g +271.31 398.433 7.6273 0.2006 re +f* +0 g +278.937 398.433 33.5201 0.2006 re +f* +1 g +312.457 398.433 6.0216 0.2006 re +f* +0.498 0 0.482 rg +318.479 398.433 92.1302 0.2006 re +f* +0 g +257.058 398.633 14.2511 0.2005 re +f* +1 g +271.31 398.633 7.6273 0.2005 re +f* +0 g +278.937 398.633 33.5201 0.2005 re +f* +1 g +312.457 398.633 6.0216 0.2005 re +f* +0.498 0 0.482 rg +318.479 398.633 92.3309 0.2005 re +f* +0 g +257.058 398.834 14.2511 0.2006 re +f* +1 g +271.31 398.834 7.6273 0.2006 re +f* +0 g +278.937 398.834 33.3194 0.2006 re +f* +1 g +312.256 398.834 6.2223 0.2006 re +f* +0.498 0 0.482 rg +318.479 398.834 92.3309 0.2006 re +f* +0 g +256.858 399.034 14.4519 0.2006 re +f* +1 g +271.31 399.034 7.6273 0.2006 re +f* +0 g +278.937 399.034 33.3194 0.2006 re +f* +1 g +312.256 399.034 6.0216 0.2006 re +f* +0.498 0 0.482 rg +318.278 399.034 92.7324 0.2006 re +f* +0 g +256.657 399.235 14.6526 0.2005 re +f* +1 g +271.31 399.235 7.6273 0.2005 re +f* +0 g +278.937 399.235 33.3194 0.2005 re +f* +1 g +312.256 399.235 6.0216 0.2005 re +f* +0.498 0 0.482 rg +318.278 399.235 92.9331 0.2005 re +f* +0 g +256.657 399.435 14.6526 0.2005 re +f* +1 g +271.31 399.435 7.6273 0.2005 re +f* +0 g +278.937 399.435 33.1187 0.2005 re +f* +1 g +312.056 399.435 6.2223 0.2005 re +f* +0.498 0 0.482 rg +318.278 399.435 92.9331 0.2005 re +f* +0 g +256.456 399.636 14.8533 0.2006 re +f* +1 g +271.31 399.636 7.6273 0.2006 re +f* +0 g +278.937 399.636 33.1187 0.2006 re +f* +1 g +312.056 399.636 6.0215 0.2006 re +f* +0.498 0 0.482 rg +318.077 399.636 93.3346 0.2006 re +f* +0 g +256.256 399.837 15.054 0.2006 re +f* +1 g +271.31 399.837 7.6273 0.2006 re +f* +0 g +278.937 399.837 33.1187 0.2006 re +f* +1 g +312.056 399.837 6.0215 0.2006 re +f* +0.498 0 0.482 rg +318.077 399.837 93.5353 0.2006 re +f* +0 g +256.256 400.037 15.054 0.2006 re +f* +1 g +271.31 400.037 7.6273 0.2006 re +f* +0 g +278.937 400.037 32.918 0.2006 re +f* +1 g +311.855 400.037 6.2222 0.2006 re +f* +0.498 0 0.482 rg +318.077 400.037 93.5353 0.2006 re +f* +0 g +256.055 400.238 15.2547 0.2005 re +f* +1 g +271.31 400.238 7.6273 0.2005 re +f* +0 g +278.937 400.238 32.918 0.2005 re +f* +1 g +311.855 400.238 6.0215 0.2005 re +f* +0.498 0 0.482 rg +317.876 400.238 93.9367 0.2005 re +f* +0 g +255.854 400.438 15.4555 0.2006 re +f* +1 g +271.31 400.438 7.6273 0.2006 re +f* +0 g +278.937 400.438 32.918 0.2006 re +f* +1 g +311.855 400.438 6.0215 0.2006 re +f* +0.498 0 0.482 rg +317.876 400.438 93.9367 0.2006 re +f* +0 g +255.854 400.639 15.4555 0.2005 re +f* +1 g +271.31 400.639 7.6273 0.2005 re +f* +0 g +278.937 400.639 32.7173 0.2005 re +f* +1 g +311.654 400.639 6.2222 0.2005 re +f* +0.498 0 0.482 rg +317.876 400.639 94.1375 0.2005 re +f* +0 g +255.653 400.839 15.6562 0.2006 re +f* +1 g +271.31 400.839 7.6273 0.2006 re +f* +0 g +278.937 400.839 32.7173 0.2006 re +f* +1 g +311.654 400.839 6.0216 0.2006 re +f* +0.498 0 0.482 rg +317.676 400.839 94.5388 0.2006 re +f* +0 g +255.653 401.04 15.6562 0.2006 re +f* +1 g +271.31 401.04 7.6273 0.2006 re +f* +0 g +278.937 401.04 32.7173 0.2006 re +f* +1 g +311.654 401.04 6.0216 0.2006 re +f* +0.498 0 0.482 rg +317.676 401.04 94.5388 0.2006 re +f* +0 g +255.453 401.241 15.8569 0.2005 re +f* +1 g +271.31 401.241 7.6273 0.2005 re +f* +0 g +278.937 401.241 32.5165 0.2005 re +f* +1 g +311.453 401.241 6.2224 0.2005 re +f* +0.498 0 0.482 rg +317.676 401.241 94.7395 0.2005 re +f* +0 g +255.252 401.441 16.0576 0.2005 re +f* +1 g +271.31 401.441 7.6273 0.2005 re +f* +0 g +278.937 401.441 32.5165 0.2005 re +f* +1 g +311.453 401.441 6.2224 0.2005 re +f* +0.498 0 0.482 rg +317.676 401.441 94.9402 0.2005 re +f* +0 g +255.252 401.642 16.0576 0.2006 re +f* +1 g +271.31 401.642 7.6273 0.2006 re +f* +0 g +278.937 401.642 32.5165 0.2006 re +f* +1 g +311.453 401.642 6.0216 0.2006 re +f* +0.498 0 0.482 rg +317.475 401.642 95.141 0.2006 re +f* +0 g +255.051 401.842 16.2583 0.2006 re +f* +1 g +271.31 401.842 7.6273 0.2006 re +f* +0 g +278.937 401.842 32.5165 0.2006 re +f* +1 g +311.453 401.842 6.0216 0.2006 re +f* +0.498 0 0.482 rg +317.475 401.842 95.3417 0.2006 re +f* +0 g +255.051 402.043 16.2583 0.2005 re +f* +1 g +271.31 402.043 7.6273 0.2005 re +f* +0 g +278.937 402.043 32.3158 0.2005 re +f* +1 g +311.253 402.043 6.2223 0.2005 re +f* +0.498 0 0.482 rg +317.475 402.043 95.3417 0.2005 re +f* +0 g +254.851 402.243 16.4591 0.2005 re +f* +1 g +271.31 402.243 7.6273 0.2005 re +f* +0 g +278.937 402.243 32.3158 0.2005 re +f* +1 g +311.253 402.243 6.2223 0.2005 re +f* +0.498 0 0.482 rg +317.475 402.243 95.5425 0.2005 re +f* +0 g +254.851 402.444 16.4591 0.2006 re +f* +1 g +271.31 402.444 7.6273 0.2006 re +f* +0 g +278.937 402.444 32.3158 0.2006 re +f* +1 g +311.253 402.444 6.0216 0.2006 re +f* +0.498 0 0.482 rg +317.274 402.444 95.7432 0.2006 re +f* +0 g +254.65 402.644 16.6598 0.2006 re +f* +1 g +271.31 402.644 7.6273 0.2006 re +f* +0 g +278.937 402.644 32.1151 0.2006 re +f* +1 g +311.052 402.644 6.2223 0.2006 re +f* +0.498 0 0.482 rg +317.274 402.644 95.9438 0.2006 re +f* +0 g +254.449 402.845 16.8605 0.2006 re +f* +1 g +271.31 402.845 7.6273 0.2006 re +f* +0 g +278.937 402.845 32.1151 0.2006 re +f* +1 g +311.052 402.845 6.2223 0.2006 re +f* +0.498 0 0.482 rg +317.274 402.845 95.9438 0.2006 re +f* +0 g +254.449 403.046 16.8605 0.2006 re +f* +1 g +271.31 403.046 7.6273 0.2006 re +f* +0 g +278.937 403.046 32.1151 0.2006 re +f* +1 g +311.052 403.046 6.2223 0.2006 re +f* +0.498 0 0.482 rg +317.274 403.046 96.1446 0.2006 re +f* +0 g +254.248 403.246 17.0612 0.2005 re +f* +1 g +271.31 403.246 7.6273 0.2005 re +f* +0 g +278.937 403.246 32.1151 0.2005 re +f* +1 g +311.052 403.246 6.2223 0.2005 re +f* +0.498 0 0.482 rg +317.274 403.246 96.1446 0.2005 re +f* +0 g +254.248 403.447 17.0612 0.2005 re +f* +1 g +271.31 403.447 7.6273 0.2005 re +f* +0 g +278.937 403.447 31.9144 0.2005 re +f* +1 g +310.851 403.447 6.423 0.2005 re +f* +0.498 0 0.482 rg +317.274 403.447 96.3453 0.2005 re +f* +0 g +254.048 403.647 17.2619 0.2006 re +f* +1 g +271.31 403.647 7.6273 0.2006 re +f* +0 g +278.937 403.647 31.9144 0.2006 re +f* +1 g +310.851 403.647 6.2223 0.2006 re +f* +0.498 0 0.482 rg +317.074 403.647 96.546 0.2006 re +f* +0 g +254.048 403.848 17.2619 0.2006 re +f* +1 g +271.31 403.848 7.6273 0.2006 re +f* +0 g +278.937 403.848 31.9144 0.2006 re +f* +1 g +310.851 403.848 6.2223 0.2006 re +f* +0.498 0 0.482 rg +317.074 403.848 96.7467 0.2006 re +f* +0 g +253.847 404.048 17.4626 0.2005 re +f* +1 g +271.31 404.048 7.6273 0.2005 re +f* +0 g +278.937 404.048 31.9144 0.2005 re +f* +1 g +310.851 404.048 6.2223 0.2005 re +f* +0.498 0 0.482 rg +317.074 404.048 13.6489 0.2005 re +f* +1 g +330.722 404.048 8.4302 0.2005 re +f* +0.498 0 0.482 rg +339.153 404.048 74.6676 0.2005 re +f* +0 g +253.847 404.249 17.4626 0.2005 re +f* +1 g +271.31 404.249 7.6273 0.2005 re +f* +0 g +278.937 404.249 31.7137 0.2005 re +f* +1 g +310.651 404.249 6.423 0.2005 re +f* +0.498 0 0.482 rg +317.074 404.249 12.2439 0.2005 re +f* +1 g +329.317 404.249 11.2403 0.2005 re +f* +0.498 0 0.482 rg +340.558 404.249 73.4633 0.2005 re +f* +0 g +253.646 404.449 17.6633 0.2006 re +f* +1 g +271.31 404.449 7.6273 0.2006 re +f* +0 g +278.937 404.449 31.7137 0.2006 re +f* +1 g +310.651 404.449 6.423 0.2006 re +f* +0.498 0 0.482 rg +317.074 404.449 11.0395 0.2006 re +f* +1 g +328.113 404.449 13.4483 0.2006 re +f* +0.498 0 0.482 rg +341.561 404.449 72.4597 0.2006 re +f* +0 g +253.646 404.65 17.6633 0.2006 re +f* +1 g +271.31 404.65 7.6273 0.2006 re +f* +0 g +278.937 404.65 31.7137 0.2006 re +f* +1 g +310.651 404.65 6.423 0.2006 re +f* +0.498 0 0.482 rg +317.074 404.65 9.8352 0.2006 re +f* +1 g +326.909 404.65 15.6561 0.2006 re +f* +0.498 0 0.482 rg +342.565 404.65 71.6568 0.2006 re +f* +0 g +253.445 404.851 17.8641 0.2005 re +f* +1 g +271.31 404.851 7.6273 0.2005 re +f* +0 g +278.937 404.851 31.7137 0.2005 re +f* +1 g +310.651 404.851 6.423 0.2005 re +f* +0.498 0 0.482 rg +317.074 404.851 8.8316 0.2005 re +f* +1 g +325.905 404.851 17.2619 0.2005 re +f* +0.498 0 0.482 rg +343.167 404.851 71.0546 0.2005 re +f* +0 g +253.445 405.051 17.8641 0.2006 re +f* +1 g +271.31 405.051 7.6273 0.2006 re +f* +0 g +278.937 405.051 31.7137 0.2006 re +f* +1 g +310.651 405.051 6.423 0.2006 re +f* +0.498 0 0.482 rg +317.074 405.051 8.0288 0.2006 re +f* +1 g +325.102 405.051 7.0251 0.2006 re +f* +0 g +332.127 405.051 6.2223 0.2006 re +f* +1 g +338.35 405.051 5.6201 0.2006 re +f* +0.498 0 0.482 rg +343.97 405.051 70.4526 0.2006 re +f* +0 g +253.445 405.252 17.8641 0.2005 re +f* +1 g +271.31 405.252 7.6273 0.2005 re +f* +0 g +278.937 405.252 31.513 0.2005 re +f* +1 g +310.45 405.252 6.4229 0.2005 re +f* +0.498 0 0.482 rg +316.873 405.252 7.6274 0.2005 re +f* +1 g +324.5 405.252 5.6201 0.2005 re +f* +0 g +330.12 405.252 9.8353 0.2005 re +f* +1 g +339.956 405.252 4.6165 0.2005 re +f* +0.498 0 0.482 rg +344.572 405.252 69.8504 0.2005 re +f* +0 g +253.245 405.452 18.0648 0.2006 re +f* +1 g +271.31 405.452 7.6273 0.2006 re +f* +0 g +278.937 405.452 31.513 0.2006 re +f* +1 g +310.45 405.452 6.4229 0.2006 re +f* +0.498 0 0.482 rg +316.873 405.452 7.0252 0.2006 re +f* +1 g +323.898 405.452 5.2187 0.2006 re +f* +0 g +329.117 405.452 12.0432 0.2006 re +f* +1 g +341.16 405.452 3.8136 0.2006 re +f* +0.498 0 0.482 rg +344.973 405.452 69.6497 0.2006 re +f* +0 g +253.245 405.653 18.0648 0.2006 re +f* +1 g +271.31 405.653 7.6273 0.2006 re +f* +0 g +278.937 405.653 31.513 0.2006 re +f* +1 g +310.45 405.653 6.4229 0.2006 re +f* +0.498 0 0.482 rg +316.873 405.653 6.4231 0.2006 re +f* +1 g +323.296 405.653 4.8172 0.2006 re +f* +0 g +328.113 405.653 13.8497 0.2006 re +f* +1 g +341.963 405.653 3.6129 0.2006 re +f* +0.498 0 0.482 rg +345.576 405.653 69.0475 0.2006 re +f* +0 g +253.044 405.853 18.2655 0.2006 re +f* +1 g +271.31 405.853 7.6273 0.2006 re +f* +0 g +278.937 405.853 31.513 0.2006 re +f* +1 g +310.45 405.853 6.4229 0.2006 re +f* +0.498 0 0.482 rg +316.873 405.853 5.821 0.2006 re +f* +1 g +322.694 405.853 4.8172 0.2006 re +f* +0 g +327.511 405.853 15.0539 0.2006 re +f* +1 g +342.565 405.853 3.4122 0.2006 re +f* +0.498 0 0.482 rg +345.977 405.853 68.8468 0.2006 re +f* +0 g +253.044 406.054 18.2655 0.2005 re +f* +1 g +271.31 406.054 7.6273 0.2005 re +f* +0 g +278.937 406.054 31.513 0.2005 re +f* +1 g +310.45 406.054 6.4229 0.2005 re +f* +0.498 0 0.482 rg +316.873 406.054 5.2188 0.2005 re +f* +1 g +322.092 406.054 4.6165 0.2005 re +f* +0 g +326.708 406.054 16.459 0.2005 re +f* +1 g +343.167 406.054 3.2115 0.2005 re +f* +0.498 0 0.482 rg +346.379 406.054 68.4453 0.2005 re +f* +0 g +252.843 406.255 18.4662 0.2005 re +f* +1 g +271.31 406.255 7.6273 0.2005 re +f* +0 g +278.937 406.255 31.3122 0.2005 re +f* +1 g +310.249 406.255 6.6237 0.2005 re +f* +0.498 0 0.482 rg +316.873 406.255 4.8174 0.2005 re +f* +1 g +321.69 406.255 4.6165 0.2005 re +f* +0 g +326.307 406.255 17.4626 0.2005 re +f* +1 g +343.769 406.255 3.0108 0.2005 re +f* +0.498 0 0.482 rg +346.78 406.255 68.0438 0.2005 re +f* +0 g +252.843 406.455 18.4662 0.2006 re +f* +1 g +271.31 406.455 7.6273 0.2006 re +f* +0 g +278.937 406.455 31.3122 0.2006 re +f* +1 g +310.249 406.455 6.6237 0.2006 re +f* +0.498 0 0.482 rg +316.873 406.455 4.2152 0.2006 re +f* +1 g +321.088 406.455 4.6165 0.2006 re +f* +0 g +325.704 406.455 18.4662 0.2006 re +f* +1 g +344.171 406.455 3.2115 0.2006 re +f* +0.498 0 0.482 rg +347.382 406.455 67.6425 0.2006 re +f* +0 g +252.843 406.656 18.4662 0.2006 re +f* +1 g +271.31 406.656 7.6273 0.2006 re +f* +0 g +278.937 406.656 31.3122 0.2006 re +f* +1 g +310.249 406.656 6.6237 0.2006 re +f* +0.498 0 0.482 rg +316.873 406.656 3.8138 0.2006 re +f* +1 g +320.687 406.656 4.6165 0.2006 re +f* +0 g +325.303 406.656 19.269 0.2006 re +f* +1 g +344.572 406.656 3.2116 0.2006 re +f* +0.498 0 0.482 rg +347.784 406.656 67.241 0.2006 re +f* +0 g +252.643 406.856 18.6669 0.2005 re +f* +1 g +271.31 406.856 7.6273 0.2005 re +f* +0 g +278.937 406.856 31.3122 0.2005 re +f* +1 g +310.249 406.856 6.8245 0.2005 re +f* +0.498 0 0.482 rg +317.074 406.856 3.0108 0.2005 re +f* +1 g +320.084 406.856 4.8172 0.2005 re +f* +0 g +324.902 406.856 20.0719 0.2005 re +f* +1 g +344.973 406.856 3.2116 0.2005 re +f* +0.498 0 0.482 rg +348.185 406.856 67.0402 0.2005 re +f* +0 g +252.643 407.057 18.6669 0.2006 re +f* +1 g +271.31 407.057 7.6273 0.2006 re +f* +0 g +278.937 407.057 31.3122 0.2006 re +f* +1 g +310.249 407.057 6.8245 0.2006 re +f* +0.498 0 0.482 rg +317.074 407.057 2.4086 0.2006 re +f* +1 g +319.482 407.057 4.8173 0.2006 re +f* +0 g +324.299 407.057 21.0755 0.2006 re +f* +1 g +345.375 407.057 3.0108 0.2006 re +f* +0.498 0 0.482 rg +348.386 407.057 66.8395 0.2006 re +f* +0 g +252.442 407.257 18.8677 0.2005 re +f* +1 g +271.31 407.257 7.6273 0.2005 re +f* +0 g +278.937 407.257 31.1115 0.2005 re +f* +1 g +310.048 407.257 7.0252 0.2005 re +f* +0.498 0 0.482 rg +317.074 407.257 2.0071 0.2005 re +f* +1 g +319.081 407.257 5.0181 0.2005 re +f* +0 g +324.099 407.257 21.4769 0.2005 re +f* +1 g +345.576 407.257 3.2116 0.2005 re +f* +0.498 0 0.482 rg +348.787 407.257 66.438 0.2005 re +f* +0 g +252.442 407.458 18.8677 0.2006 re +f* +1 g +271.31 407.458 7.6273 0.2006 re +f* +0 g +278.937 407.458 31.1115 0.2006 re +f* +1 g +310.048 407.458 7.0252 0.2006 re +f* +0.498 0 0.482 rg +317.074 407.458 1.405 0.2006 re +f* +1 g +318.479 407.458 5.2187 0.2006 re +f* +0 g +323.697 407.458 22.2798 0.2006 re +f* +1 g +345.977 407.458 3.2116 0.2006 re +f* +0.498 0 0.482 rg +349.189 407.458 66.2374 0.2006 re +f* +0 g +252.442 407.658 18.8677 0.2006 re +f* +1 g +271.31 407.658 7.6273 0.2006 re +f* +0 g +278.937 407.658 31.1115 0.2006 re +f* +1 g +310.048 407.658 7.0252 0.2006 re +f* +0.498 0 0.482 rg +317.074 407.658 1.0035 0.2006 re +f* +1 g +318.077 407.658 5.2188 0.2006 re +f* +0 g +323.296 407.658 22.882 0.2006 re +f* +1 g +346.178 407.658 3.2115 0.2006 re +f* +0.498 0 0.482 rg +349.389 407.658 66.0367 0.2006 re +f* +0 g +252.241 407.859 19.0684 0.2005 re +f* +1 g +271.31 407.859 7.6273 0.2005 re +f* +0 g +278.937 407.859 31.1115 0.2005 re +f* +1 g +310.048 407.859 7.0252 0.2005 re +f* +0.498 0 0.482 rg +317.074 407.859 0.4014 0.2005 re +f* +1 g +317.475 407.859 5.4194 0.2005 re +f* +0 g +322.894 407.859 23.6849 0.2005 re +f* +1 g +346.579 407.859 3.2116 0.2005 re +f* +0.498 0 0.482 rg +349.791 407.859 65.8359 0.2005 re +f* +0 g +252.241 408.06 19.0684 0.2006 re +f* +1 g +271.31 408.06 7.6273 0.2006 re +f* +0 g +278.937 408.06 31.1115 0.2006 re +f* +1 g +310.048 408.06 12.6454 0.2006 re +f* +0 g +322.694 408.06 24.0863 0.2006 re +f* +1 g +346.78 408.06 3.2114 0.2006 re +f* +0.498 0 0.482 rg +349.991 408.06 65.6353 0.2006 re +f* +0 g +252.241 408.26 19.0684 0.2005 re +f* +1 g +271.31 408.26 7.6273 0.2005 re +f* +0 g +278.937 408.26 31.1115 0.2005 re +f* +1 g +310.048 408.26 12.2439 0.2005 re +f* +0 g +322.292 408.26 24.8892 0.2005 re +f* +1 g +347.181 408.26 3.2115 0.2005 re +f* +0.498 0 0.482 rg +350.393 408.26 65.2338 0.2005 re +f* +0 g +252.04 408.461 19.2691 0.2006 re +f* +1 g +271.31 408.461 7.6273 0.2006 re +f* +0 g +278.937 408.461 31.1115 0.2006 re +f* +1 g +310.048 408.461 12.0432 0.2006 re +f* +0 g +322.092 408.461 25.2906 0.2006 re +f* +1 g +347.382 408.461 3.2115 0.2006 re +f* +0.498 0 0.482 rg +350.594 408.461 65.2338 0.2006 re +f* +0 g +252.04 408.661 19.2691 0.2006 re +f* +1 g +271.31 408.661 7.6273 0.2006 re +f* +0 g +278.937 408.661 30.9108 0.2006 re +f* +1 g +309.848 408.661 11.8425 0.2006 re +f* +0 g +321.69 408.661 25.8927 0.2006 re +f* +1 g +347.583 408.661 3.2116 0.2006 re +f* +0.498 0 0.482 rg +350.794 408.661 65.033 0.2006 re +f* +0 g +252.04 408.862 19.2691 0.2005 re +f* +1 g +271.31 408.862 7.6273 0.2005 re +f* +0 g +278.937 408.862 30.9108 0.2005 re +f* +1 g +309.848 408.862 11.6417 0.2005 re +f* +0 g +321.489 408.862 26.2943 0.2005 re +f* +1 g +347.784 408.862 3.4122 0.2005 re +f* +0.498 0 0.482 rg +351.196 408.862 64.6316 0.2005 re +f* +0 g +251.84 409.062 19.4698 0.2006 re +f* +1 g +271.31 409.062 7.6273 0.2006 re +f* +0 g +278.937 409.062 30.9108 0.2006 re +f* +1 g +309.848 409.062 11.2403 0.2006 re +f* +0 g +321.088 409.062 26.8963 0.2006 re +f* +1 g +347.984 409.062 3.4123 0.2006 re +f* +0.498 0 0.482 rg +351.397 409.062 64.6317 0.2006 re +f* +0 g +251.84 409.263 19.4698 0.2005 re +f* +1 g +271.31 409.263 7.6273 0.2005 re +f* +0 g +278.937 409.263 30.9108 0.2005 re +f* +1 g +309.848 409.263 11.0395 0.2005 re +f* +0 g +320.887 409.263 27.4986 0.2005 re +f* +1 g +348.386 409.263 3.2115 0.2005 re +f* +0.498 0 0.482 rg +351.597 409.263 64.431 0.2005 re +f* +0 g +251.84 409.463 19.4698 0.2006 re +f* +1 g +271.31 409.463 7.6273 0.2006 re +f* +0 g +278.937 409.463 30.9108 0.2006 re +f* +1 g +309.848 409.463 10.8389 0.2006 re +f* +0 g +320.687 409.463 27.6992 0.2006 re +f* +1 g +348.386 409.463 3.6129 0.2006 re +f* +0.498 0 0.482 rg +351.999 409.463 64.0296 0.2006 re +f* +0 g +251.639 409.664 19.6705 0.2006 re +f* +1 g +271.31 409.664 7.6273 0.2006 re +f* +0 g +278.937 409.664 30.9108 0.2006 re +f* +1 g +309.848 409.664 10.4374 0.2006 re +f* +0 g +320.285 409.664 28.3014 0.2006 re +f* +1 g +348.586 409.664 3.613 0.2006 re +f* +0.498 0 0.482 rg +352.2 409.664 64.0294 0.2006 re +f* +0 g +251.639 409.865 19.6705 0.2005 re +f* +1 g +271.31 409.865 7.6273 0.2005 re +f* +0 g +278.937 409.865 30.9108 0.2005 re +f* +1 g +309.848 409.865 10.2367 0.2005 re +f* +0 g +320.084 409.865 28.7029 0.2005 re +f* +1 g +348.787 409.865 3.6129 0.2005 re +f* +0.498 0 0.482 rg +352.4 409.865 63.8287 0.2005 re +f* +0 g +251.639 410.065 19.6705 0.2006 re +f* +1 g +271.31 410.065 7.6273 0.2006 re +f* +0 g +278.937 410.065 30.7101 0.2006 re +f* +1 g +309.647 410.065 10.2366 0.2006 re +f* +0 g +319.884 410.065 29.1043 0.2006 re +f* +1 g +348.988 410.065 3.613 0.2006 re +f* +0.498 0 0.482 rg +352.601 410.065 63.628 0.2006 re +f* +0 g +251.438 410.266 19.8713 0.2005 re +f* +1 g +271.31 410.266 7.6273 0.2005 re +f* +0 g +278.937 410.266 30.7101 0.2005 re +f* +1 g +309.647 410.266 10.036 0.2005 re +f* +0 g +319.683 410.266 29.5057 0.2005 re +f* +1 g +349.189 410.266 3.613 0.2005 re +f* +0.498 0 0.482 rg +352.802 410.266 63.4272 0.2005 re +f* +0 g +251.438 410.466 19.8713 0.2006 re +f* +1 g +271.31 410.466 7.6273 0.2006 re +f* +0 g +278.937 410.466 30.7101 0.2006 re +f* +1 g +309.647 410.466 9.8352 0.2006 re +f* +0 g +319.482 410.466 29.9072 0.2006 re +f* +1 g +349.389 410.466 3.6129 0.2006 re +f* +0.498 0 0.482 rg +353.002 410.466 63.4274 0.2006 re +f* +0 g +251.438 410.667 19.8713 0.2005 re +f* +1 g +271.31 410.667 7.6273 0.2005 re +f* +0 g +278.937 410.667 30.7101 0.2005 re +f* +1 g +309.647 410.667 9.6345 0.2005 re +f* +0 g +319.281 410.667 30.3086 0.2005 re +f* +1 g +349.59 410.667 3.613 0.2005 re +f* +0.498 0 0.482 rg +353.203 410.667 63.2266 0.2005 re +f* +0 g +251.438 410.867 19.8713 0.2006 re +f* +1 g +271.31 410.867 7.6273 0.2006 re +f* +0 g +278.937 410.867 30.7101 0.2006 re +f* +1 g +309.647 410.867 9.4337 0.2006 re +f* +0 g +319.081 410.867 30.5094 0.2006 re +f* +1 g +349.59 410.867 3.8137 0.2006 re +f* +0.498 0 0.482 rg +353.404 410.867 63.0259 0.2006 re +f* +0 g +251.238 411.068 20.072 0.2006 re +f* +1 g +271.31 411.068 7.6273 0.2006 re +f* +0 g +278.937 411.068 30.7101 0.2006 re +f* +1 g +309.647 411.068 9.233 0.2006 re +f* +0 g +318.88 411.068 30.9109 0.2006 re +f* +1 g +349.791 411.068 3.8136 0.2006 re +f* +0.498 0 0.482 rg +353.605 411.068 62.8252 0.2006 re +f* +0 g +251.238 411.268 20.072 0.2005 re +f* +1 g +271.31 411.268 7.6273 0.2005 re +f* +0 g +278.937 411.268 30.7101 0.2005 re +f* +1 g +309.647 411.268 9.0324 0.2005 re +f* +0 g +318.679 411.268 31.3121 0.2005 re +f* +1 g +349.991 411.268 3.8138 0.2005 re +f* +0.498 0 0.482 rg +353.805 411.268 28.7028 0.2005 re +f* +1 g +382.508 411.268 1.2043 0.2005 re +f* +0.498 0 0.482 rg +383.712 411.268 23.2835 0.2005 re +f* +1 g +406.996 411.268 1.6057 0.2005 re +f* +0.498 0 0.482 rg +408.602 411.268 8.0288 0.2005 re +f* +0 g +251.238 411.469 20.072 0.2006 re +f* +1 g +271.31 411.469 7.6273 0.2006 re +f* +0 g +278.937 411.469 30.7101 0.2006 re +f* +1 g +309.647 411.469 8.8316 0.2006 re +f* +0 g +318.479 411.469 31.5129 0.2006 re +f* +1 g +349.991 411.469 4.0144 0.2006 re +f* +0.498 0 0.482 rg +354.006 411.469 27.0972 0.2006 re +f* +1 g +381.103 411.469 3.8136 0.2006 re +f* +0.498 0 0.482 rg +384.917 411.469 20.4734 0.2006 re +f* +1 g +405.39 411.469 4.6166 0.2006 re +f* +0.498 0 0.482 rg +410.007 411.469 6.6237 0.2006 re +f* +0 g +251.238 411.67 20.072 0.2005 re +f* +1 g +271.31 411.67 7.6273 0.2005 re +f* +0 g +278.937 411.67 30.5094 0.2005 re +f* +1 g +309.446 411.67 8.8316 0.2005 re +f* +0 g +318.278 411.67 31.9144 0.2005 re +f* +1 g +350.192 411.67 4.0144 0.2005 re +f* +0.498 0 0.482 rg +354.207 411.67 26.2942 0.2005 re +f* +1 g +380.501 411.67 4.8173 0.2005 re +f* +0.498 0 0.482 rg +385.318 411.67 19.269 0.2005 re +f* +1 g +404.587 411.67 6.0216 0.2005 re +f* +0.498 0 0.482 rg +410.609 411.67 6.0216 0.2005 re +f* +0 g +251.037 411.87 20.2727 0.2006 re +f* +1 g +271.31 411.87 7.6273 0.2006 re +f* +0 g +278.937 411.87 30.5094 0.2006 re +f* +1 g +309.446 411.87 8.6308 0.2006 re +f* +0 g +318.077 411.87 32.3159 0.2006 re +f* +1 g +350.393 411.87 4.0144 0.2006 re +f* +0.498 0 0.482 rg +354.407 411.87 6.2223 0.2006 re +f* +1 g +360.63 411.87 9.6345 0.2006 re +f* +0.498 0 0.482 rg +370.264 411.87 9.6346 0.2006 re +f* +1 g +379.899 411.87 5.8208 0.2006 re +f* +0.498 0 0.482 rg +385.72 411.87 2.6093 0.2006 re +f* +1 g +388.329 411.87 0.2008 0.2006 re +f* +0.498 0 0.482 rg +388.53 411.87 6.2223 0.2006 re +f* +1 g +394.752 411.87 0.2007 0.2006 re +f* +0.498 0 0.482 rg +394.953 411.87 9.0324 0.2006 re +f* +1 g +403.985 411.87 7.2259 0.2006 re +f* +0.498 0 0.482 rg +411.211 411.87 5.4194 0.2006 re +f* +0 g +251.037 412.071 20.2727 0.2006 re +f* +1 g +271.31 412.071 7.6273 0.2006 re +f* +0 g +278.937 412.071 30.5094 0.2006 re +f* +1 g +309.446 412.071 8.4301 0.2006 re +f* +0 g +317.876 412.071 32.5166 0.2006 re +f* +1 g +350.393 412.071 4.0144 0.2006 re +f* +0.498 0 0.482 rg +354.407 412.071 6.2223 0.2006 re +f* +1 g +360.63 412.071 9.6345 0.2006 re +f* +0.498 0 0.482 rg +370.264 412.071 9.2331 0.2006 re +f* +1 g +379.497 412.071 2.8101 0.2006 re +f* +0.498 0 0.482 rg +382.307 412.071 1.6058 0.2006 re +f* +1 g +383.913 412.071 2.2078 0.2006 re +f* +0.498 0 0.482 rg +386.121 412.071 2.2079 0.2006 re +f* +1 g +388.329 412.071 6.6238 0.2006 re +f* +0.498 0 0.482 rg +394.953 412.071 8.6309 0.2006 re +f* +1 g +403.584 412.071 3.4123 0.2006 re +f* +0.498 0 0.482 rg +406.996 412.071 1.8065 0.2006 re +f* +1 g +408.802 412.071 2.6093 0.2006 re +f* +0.498 0 0.482 rg +411.412 412.071 5.4194 0.2006 re +f* +0 g +251.037 412.271 20.2727 0.2005 re +f* +1 g +271.31 412.271 7.6273 0.2005 re +f* +0 g +278.937 412.271 30.5094 0.2005 re +f* +1 g +309.446 412.271 8.2295 0.2005 re +f* +0 g +317.676 412.271 32.9179 0.2005 re +f* +1 g +350.594 412.271 4.0144 0.2005 re +f* +0.498 0 0.482 rg +354.608 412.271 6.0216 0.2005 re +f* +1 g +360.63 412.271 9.6345 0.2005 re +f* +0.498 0 0.482 rg +370.264 412.271 8.8317 0.2005 re +f* +1 g +379.096 412.271 2.2079 0.2005 re +f* +0.498 0 0.482 rg +381.304 412.271 3.4122 0.2005 re +f* +1 g +384.716 412.271 1.6057 0.2005 re +f* +0.498 0 0.482 rg +386.322 412.271 2.0072 0.2005 re +f* +1 g +388.329 412.271 6.6238 0.2005 re +f* +0.498 0 0.482 rg +394.953 412.271 8.2295 0.2005 re +f* +1 g +403.182 412.271 3.0108 0.2005 re +f* +0.498 0 0.482 rg +406.193 412.271 3.613 0.2005 re +f* +1 g +409.806 412.271 2.0071 0.2005 re +f* +0.498 0 0.482 rg +411.813 412.271 5.018 0.2005 re +f* +0 g +251.037 412.472 20.2727 0.2006 re +f* +1 g +271.31 412.472 7.6273 0.2006 re +f* +0 g +278.937 412.472 30.5094 0.2006 re +f* +1 g +309.446 412.472 8.0287 0.2006 re +f* +0 g +317.475 412.472 21.0756 0.2006 re +f* +1 g +338.551 412.472 2.81 0.2006 re +f* +0 g +341.361 412.472 9.2331 0.2006 re +f* +1 g +350.594 412.472 4.2151 0.2006 re +f* +0.498 0 0.482 rg +354.809 412.472 5.8209 0.2006 re +f* +1 g +360.63 412.472 9.6345 0.2006 re +f* +0.498 0 0.482 rg +370.264 412.472 8.4303 0.2006 re +f* +1 g +378.695 412.472 2.2079 0.2006 re +f* +0.498 0 0.482 rg +380.902 412.472 4.4158 0.2006 re +f* +1 g +385.318 412.472 1.405 0.2006 re +f* +0.498 0 0.482 rg +386.723 412.472 1.6057 0.2006 re +f* +1 g +388.329 412.472 6.6238 0.2006 re +f* +0.498 0 0.482 rg +394.953 412.472 7.8281 0.2006 re +f* +1 g +402.781 412.472 2.8101 0.2006 re +f* +0.498 0 0.482 rg +405.591 412.472 4.8172 0.2006 re +f* +1 g +410.408 412.472 1.8065 0.2006 re +f* +0.498 0 0.482 rg +412.215 412.472 4.6165 0.2006 re +f* +0 g +250.836 412.672 20.4734 0.2005 re +f* +1 g +271.31 412.672 7.6273 0.2005 re +f* +0 g +278.937 412.672 30.5094 0.2005 re +f* +1 g +309.446 412.672 8.0287 0.2005 re +f* +0 g +317.475 412.672 19.8713 0.2005 re +f* +1 g +337.346 412.672 5.0179 0.2005 re +f* +0 g +342.364 412.672 8.4303 0.2005 re +f* +1 g +350.794 412.672 4.215 0.2005 re +f* +0.498 0 0.482 rg +355.01 412.672 8.631 0.2005 re +f* +1 g +363.641 412.672 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 412.672 11.2403 0.2005 re +f* +1 g +378.494 412.672 2.0072 0.2005 re +f* +0.498 0 0.482 rg +380.501 412.672 5.018 0.2005 re +f* +1 g +385.519 412.672 1.4051 0.2005 re +f* +0.498 0 0.482 rg +386.924 412.672 1.4049 0.2005 re +f* +1 g +388.329 412.672 3.4123 0.2005 re +f* +0.498 0 0.482 rg +391.741 412.672 10.6381 0.2005 re +f* +1 g +402.379 412.672 2.8101 0.2005 re +f* +0.498 0 0.482 rg +405.189 412.672 5.6201 0.2005 re +f* +1 g +410.81 412.672 1.6058 0.2005 re +f* +0.498 0 0.482 rg +412.415 412.672 4.4158 0.2005 re +f* +0 g +250.836 412.873 20.4734 0.2006 re +f* +1 g +271.31 412.873 7.6273 0.2006 re +f* +0 g +278.937 412.873 30.5094 0.2006 re +f* +1 g +309.446 412.873 7.828 0.2006 re +f* +0 g +317.274 412.873 19.4698 0.2006 re +f* +1 g +336.744 412.873 6.2223 0.2006 re +f* +0 g +342.966 412.873 8.0287 0.2006 re +f* +1 g +350.995 412.873 4.2152 0.2006 re +f* +0.498 0 0.482 rg +355.21 412.873 8.4302 0.2006 re +f* +1 g +363.641 412.873 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 412.873 10.8389 0.2006 re +f* +1 g +378.092 412.873 2.2079 0.2006 re +f* +0.498 0 0.482 rg +380.3 412.873 5.6201 0.2006 re +f* +1 g +385.92 412.873 1.2043 0.2006 re +f* +0.498 0 0.482 rg +387.125 412.873 1.2043 0.2006 re +f* +1 g +388.329 412.873 3.4123 0.2006 re +f* +0.498 0 0.482 rg +391.741 412.873 10.4374 0.2006 re +f* +1 g +402.179 412.873 2.8101 0.2006 re +f* +0.498 0 0.482 rg +404.989 412.873 6.2223 0.2006 re +f* +1 g +411.211 412.873 1.405 0.2006 re +f* +0.498 0 0.482 rg +412.616 412.873 4.4159 0.2006 re +f* +0 g +250.836 413.073 20.4734 0.2006 re +f* +1 g +271.31 413.073 7.6273 0.2006 re +f* +0 g +278.937 413.073 13.0467 0.2006 re +f* +1 g +291.984 413.073 10.036 0.2006 re +f* +0 g +302.02 413.073 7.4267 0.2006 re +f* +1 g +309.446 413.073 7.6273 0.2006 re +f* +0 g +317.074 413.073 19.0683 0.2006 re +f* +1 g +336.142 413.073 7.2259 0.2006 re +f* +0 g +343.368 413.073 7.6273 0.2006 re +f* +1 g +350.995 413.073 4.2152 0.2006 re +f* +0.498 0 0.482 rg +355.21 413.073 8.4302 0.2006 re +f* +1 g +363.641 413.073 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 413.073 10.6382 0.2006 re +f* +1 g +377.892 413.073 2.2079 0.2006 re +f* +0.498 0 0.482 rg +380.099 413.073 6.0215 0.2006 re +f* +1 g +386.121 413.073 1.2043 0.2006 re +f* +0.498 0 0.482 rg +387.325 413.073 1.0036 0.2006 re +f* +1 g +388.329 413.073 3.4123 0.2006 re +f* +0.498 0 0.482 rg +391.741 413.073 10.036 0.2006 re +f* +1 g +401.777 413.073 3.0108 0.2006 re +f* +0.498 0 0.482 rg +404.788 413.073 6.8244 0.2006 re +f* +1 g +411.612 413.073 1.2043 0.2006 re +f* +0.498 0 0.482 rg +412.817 413.073 4.2152 0.2006 re +f* +0 g +250.836 413.274 20.4734 0.2005 re +f* +1 g +271.31 413.274 7.6273 0.2005 re +f* +0 g +278.937 413.274 13.0467 0.2005 re +f* +1 g +291.984 413.274 10.036 0.2005 re +f* +0 g +302.02 413.274 7.4267 0.2005 re +f* +1 g +309.446 413.274 7.4265 0.2005 re +f* +0 g +316.873 413.274 18.667 0.2005 re +f* +1 g +335.54 413.274 3.2115 0.2005 re +f* +0 g +338.751 413.274 2.8101 0.2005 re +f* +1 g +341.561 413.274 2.2079 0.2005 re +f* +0 g +343.769 413.274 7.4266 0.2005 re +f* +1 g +351.196 413.274 4.2151 0.2005 re +f* +0.498 0 0.482 rg +355.411 413.274 8.2295 0.2005 re +f* +1 g +363.641 413.274 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 413.274 10.4375 0.2005 re +f* +1 g +377.691 413.274 2.2079 0.2005 re +f* +0.498 0 0.482 rg +379.899 413.274 6.4229 0.2005 re +f* +1 g +386.322 413.274 1.0036 0.2005 re +f* +0.498 0 0.482 rg +387.325 413.274 1.0036 0.2005 re +f* +1 g +388.329 413.274 3.4123 0.2005 re +f* +0.498 0 0.482 rg +391.741 413.274 9.8352 0.2005 re +f* +1 g +401.576 413.274 3.0108 0.2005 re +f* +0.498 0 0.482 rg +404.587 413.274 7.2259 0.2005 re +f* +1 g +411.813 413.274 1.2044 0.2005 re +f* +0.498 0 0.482 rg +413.017 413.274 4.0144 0.2005 re +f* +0 g +250.836 413.475 20.4734 0.2006 re +f* +1 g +271.31 413.475 7.6273 0.2006 re +f* +0 g +278.937 413.475 13.0467 0.2006 re +f* +1 g +291.984 413.475 10.036 0.2006 re +f* +0 g +302.02 413.475 7.4267 0.2006 re +f* +1 g +309.446 413.475 7.4265 0.2006 re +f* +0 g +316.873 413.475 18.2655 0.2006 re +f* +1 g +335.138 413.475 3.0108 0.2006 re +f* +0 g +338.149 413.475 4.2151 0.2006 re +f* +1 g +342.364 413.475 1.8065 0.2006 re +f* +0 g +344.171 413.475 7.0252 0.2006 re +f* +1 g +351.196 413.475 4.4158 0.2006 re +f* +0.498 0 0.482 rg +355.612 413.475 8.0288 0.2006 re +f* +1 g +363.641 413.475 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 413.475 10.2367 0.2006 re +f* +1 g +377.49 413.475 2.208 0.2006 re +f* +0.498 0 0.482 rg +379.698 413.475 6.8244 0.2006 re +f* +1 g +386.522 413.475 1.0036 0.2006 re +f* +0.498 0 0.482 rg +387.526 413.475 0.8028 0.2006 re +f* +1 g +388.329 413.475 3.4123 0.2006 re +f* +0.498 0 0.482 rg +391.741 413.475 9.6345 0.2006 re +f* +1 g +401.376 413.475 3.0108 0.2006 re +f* +0.498 0 0.482 rg +404.386 413.475 7.6274 0.2006 re +f* +1 g +412.014 413.475 1.2042 0.2006 re +f* +0.498 0 0.482 rg +413.218 413.475 3.8138 0.2006 re +f* +0 g +250.836 413.675 20.4734 0.2005 re +f* +1 g +271.31 413.675 7.6273 0.2005 re +f* +0 g +278.937 413.675 13.0467 0.2005 re +f* +1 g +291.984 413.675 10.036 0.2005 re +f* +0 g +302.02 413.675 7.4267 0.2005 re +f* +1 g +309.446 413.675 7.2258 0.2005 re +f* +0 g +316.672 413.675 18.2655 0.2005 re +f* +1 g +334.938 413.675 2.8101 0.2005 re +f* +0 g +337.748 413.675 5.018 0.2005 re +f* +1 g +342.766 413.675 1.6057 0.2005 re +f* +0 g +344.371 413.675 6.8245 0.2005 re +f* +1 g +351.196 413.675 4.6165 0.2005 re +f* +0.498 0 0.482 rg +355.812 413.675 7.8281 0.2005 re +f* +1 g +363.641 413.675 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 413.675 10.036 0.2005 re +f* +1 g +377.289 413.675 2.2079 0.2005 re +f* +0.498 0 0.482 rg +379.497 413.675 7.2259 0.2005 re +f* +1 g +386.723 413.675 1.0036 0.2005 re +f* +0.498 0 0.482 rg +387.727 413.675 0.6021 0.2005 re +f* +1 g +388.329 413.675 3.4123 0.2005 re +f* +0.498 0 0.482 rg +391.741 413.675 9.4338 0.2005 re +f* +1 g +401.175 413.675 3.0108 0.2005 re +f* +0.498 0 0.482 rg +404.186 413.675 8.0288 0.2005 re +f* +1 g +412.215 413.675 1.2043 0.2005 re +f* +0.498 0 0.482 rg +413.419 413.675 3.613 0.2005 re +f* +0 g +250.635 413.876 20.6741 0.2006 re +f* +1 g +271.31 413.876 7.6273 0.2006 re +f* +0 g +278.937 413.876 16.0575 0.2006 re +f* +1 g +294.994 413.876 3.613 0.2006 re +f* +0 g +298.607 413.876 10.8389 0.2006 re +f* +1 g +309.446 413.876 7.0251 0.2006 re +f* +0 g +316.471 413.876 18.0648 0.2006 re +f* +1 g +334.536 413.876 2.8101 0.2006 re +f* +0 g +337.346 413.876 5.8208 0.2006 re +f* +1 g +343.167 413.876 1.6058 0.2006 re +f* +0 g +344.773 413.876 6.6237 0.2006 re +f* +1 g +351.397 413.876 4.4158 0.2006 re +f* +0.498 0 0.482 rg +355.812 413.876 7.8281 0.2006 re +f* +1 g +363.641 413.876 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 413.876 9.8353 0.2006 re +f* +1 g +377.089 413.876 2.4086 0.2006 re +f* +0.498 0 0.482 rg +379.497 413.876 7.4267 0.2006 re +f* +1 g +386.924 413.876 0.8028 0.2006 re +f* +0.498 0 0.482 rg +387.727 413.876 0.6021 0.2006 re +f* +1 g +388.329 413.876 3.4123 0.2006 re +f* +0.498 0 0.482 rg +391.741 413.876 9.2331 0.2006 re +f* +1 g +400.974 413.876 3.0108 0.2006 re +f* +0.498 0 0.482 rg +403.985 413.876 8.4302 0.2006 re +f* +1 g +412.415 413.876 1.2043 0.2006 re +f* +0.498 0 0.482 rg +413.62 413.876 3.4123 0.2006 re +f* +0 g +250.635 414.076 20.6741 0.2006 re +f* +1 g +271.31 414.076 7.6273 0.2006 re +f* +0 g +278.937 414.076 16.0575 0.2006 re +f* +1 g +294.994 414.076 3.613 0.2006 re +f* +0 g +298.607 414.076 10.6381 0.2006 re +f* +1 g +309.245 414.076 7.2259 0.2006 re +f* +0 g +316.471 414.076 17.6633 0.2006 re +f* +1 g +334.135 414.076 3.0108 0.2006 re +f* +0 g +337.146 414.076 6.423 0.2006 re +f* +1 g +343.568 414.076 1.405 0.2006 re +f* +0 g +344.973 414.076 6.4231 0.2006 re +f* +1 g +351.397 414.076 4.6165 0.2006 re +f* +0.498 0 0.482 rg +356.013 414.076 7.6274 0.2006 re +f* +1 g +363.641 414.076 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 414.076 9.6346 0.2006 re +f* +1 g +376.888 414.076 2.4086 0.2006 re +f* +0.498 0 0.482 rg +379.297 414.076 7.6274 0.2006 re +f* +1 g +386.924 414.076 1.0036 0.2006 re +f* +0.498 0 0.482 rg +387.928 414.076 0.4013 0.2006 re +f* +1 g +388.329 414.076 3.4123 0.2006 re +f* +0.498 0 0.482 rg +391.741 414.076 9.0324 0.2006 re +f* +1 g +400.774 414.076 3.0108 0.2006 re +f* +0.498 0 0.482 rg +403.784 414.076 8.8316 0.2006 re +f* +1 g +412.616 414.076 1.0036 0.2006 re +f* +0.498 0 0.482 rg +413.62 414.076 3.6129 0.2006 re +f* +0 g +250.635 414.277 20.6741 0.2005 re +f* +1 g +271.31 414.277 7.6273 0.2005 re +f* +0 g +278.937 414.277 16.0575 0.2005 re +f* +1 g +294.994 414.277 3.613 0.2005 re +f* +0 g +298.607 414.277 10.6381 0.2005 re +f* +1 g +309.245 414.277 7.0252 0.2005 re +f* +0 g +316.271 414.277 17.6633 0.2005 re +f* +1 g +333.934 414.277 3.0108 0.2005 re +f* +0 g +336.945 414.277 6.8245 0.2005 re +f* +1 g +343.769 414.277 1.405 0.2005 re +f* +0 g +345.174 414.277 6.423 0.2005 re +f* +1 g +351.597 414.277 4.6165 0.2005 re +f* +0.498 0 0.482 rg +356.214 414.277 7.4267 0.2005 re +f* +1 g +363.641 414.277 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 414.277 9.4339 0.2005 re +f* +1 g +376.687 414.277 2.6093 0.2005 re +f* +0.498 0 0.482 rg +379.297 414.277 7.828 0.2005 re +f* +1 g +387.125 414.277 0.803 0.2005 re +f* +0.498 0 0.482 rg +387.928 414.277 0.4013 0.2005 re +f* +1 g +388.329 414.277 3.4123 0.2005 re +f* +0.498 0 0.482 rg +391.741 414.277 8.8316 0.2005 re +f* +1 g +400.573 414.277 3.2116 0.2005 re +f* +0.498 0 0.482 rg +403.784 414.277 9.0323 0.2005 re +f* +1 g +412.817 414.277 1.0036 0.2005 re +f* +0.498 0 0.482 rg +413.82 414.277 3.4122 0.2005 re +f* +0 g +250.635 414.477 20.6741 0.2005 re +f* +1 g +271.31 414.477 7.6273 0.2005 re +f* +0 g +278.937 414.477 16.0575 0.2005 re +f* +1 g +294.994 414.477 3.613 0.2005 re +f* +0 g +298.607 414.477 10.6381 0.2005 re +f* +1 g +309.245 414.477 6.8245 0.2005 re +f* +0 g +316.07 414.477 17.6633 0.2005 re +f* +1 g +333.733 414.477 3.0108 0.2005 re +f* +0 g +336.744 414.477 7.4266 0.2005 re +f* +1 g +344.171 414.477 1.2043 0.2005 re +f* +0 g +345.375 414.477 6.2223 0.2005 re +f* +1 g +351.597 414.477 4.6165 0.2005 re +f* +0.498 0 0.482 rg +356.214 414.477 7.4267 0.2005 re +f* +1 g +363.641 414.477 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 414.477 9.2331 0.2005 re +f* +1 g +376.486 414.477 2.6094 0.2005 re +f* +0.498 0 0.482 rg +379.096 414.477 8.0287 0.2005 re +f* +1 g +387.125 414.477 1.0036 0.2005 re +f* +0.498 0 0.482 rg +388.128 414.477 0.2007 0.2005 re +f* +1 g +388.329 414.477 3.4123 0.2005 re +f* +0.498 0 0.482 rg +391.741 414.477 8.6309 0.2005 re +f* +1 g +400.372 414.477 3.2115 0.2005 re +f* +0.498 0 0.482 rg +403.584 414.477 9.4339 0.2005 re +f* +1 g +413.017 414.477 1.0036 0.2005 re +f* +0.498 0 0.482 rg +414.021 414.477 3.2114 0.2005 re +f* +0 g +250.635 414.678 20.6741 0.2006 re +f* +1 g +271.31 414.678 7.6273 0.2006 re +f* +0 g +278.937 414.678 16.0575 0.2006 re +f* +1 g +294.994 414.678 3.613 0.2006 re +f* +0 g +298.607 414.678 10.6381 0.2006 re +f* +1 g +309.245 414.678 6.8245 0.2006 re +f* +0 g +316.07 414.678 17.4626 0.2006 re +f* +1 g +333.533 414.678 3.0108 0.2006 re +f* +0 g +336.543 414.678 7.828 0.2006 re +f* +1 g +344.371 414.678 1.0036 0.2006 re +f* +0 g +345.375 414.678 6.2223 0.2006 re +f* +1 g +351.597 414.678 4.8173 0.2006 re +f* +0.498 0 0.482 rg +356.415 414.678 7.2259 0.2006 re +f* +1 g +363.641 414.678 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 414.678 9.0324 0.2006 re +f* +1 g +376.286 414.678 2.8101 0.2006 re +f* +0.498 0 0.482 rg +379.096 414.678 8.2294 0.2006 re +f* +1 g +387.325 414.678 0.8029 0.2006 re +f* +0.498 0 0.482 rg +388.128 414.678 0.2007 0.2006 re +f* +1 g +388.329 414.678 3.4123 0.2006 re +f* +0.498 0 0.482 rg +391.741 414.678 8.4302 0.2006 re +f* +1 g +400.171 414.678 3.4122 0.2006 re +f* +0.498 0 0.482 rg +403.584 414.678 9.4339 0.2006 re +f* +1 g +413.017 414.678 1.0036 0.2006 re +f* +0.498 0 0.482 rg +414.021 414.678 3.2114 0.2006 re +f* +0 g +250.635 414.878 20.6741 0.2006 re +f* +1 g +271.31 414.878 7.6273 0.2006 re +f* +0 g +278.937 414.878 16.0575 0.2006 re +f* +1 g +294.994 414.878 3.613 0.2006 re +f* +0 g +298.607 414.878 10.6381 0.2006 re +f* +1 g +309.245 414.878 6.6237 0.2006 re +f* +0 g +315.869 414.878 17.4626 0.2006 re +f* +1 g +333.332 414.878 3.0109 0.2006 re +f* +0 g +336.343 414.878 8.2294 0.2006 re +f* +1 g +344.572 414.878 1.0036 0.2006 re +f* +0 g +345.576 414.878 6.2224 0.2006 re +f* +1 g +351.798 414.878 4.6165 0.2006 re +f* +0.498 0 0.482 rg +356.415 414.878 7.2259 0.2006 re +f* +1 g +363.641 414.878 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 414.878 8.8317 0.2006 re +f* +1 g +376.085 414.878 3.0108 0.2006 re +f* +0.498 0 0.482 rg +379.096 414.878 8.2294 0.2006 re +f* +1 g +387.325 414.878 4.4159 0.2006 re +f* +0.498 0 0.482 rg +391.741 414.878 8.4302 0.2006 re +f* +1 g +400.171 414.878 3.2115 0.2006 re +f* +0.498 0 0.482 rg +403.383 414.878 9.8352 0.2006 re +f* +1 g +413.218 414.878 1.0036 0.2006 re +f* +0.498 0 0.482 rg +414.222 414.878 3.0108 0.2006 re +f* +0 g +250.435 415.079 20.8749 0.2006 re +f* +1 g +271.31 415.079 7.6273 0.2006 re +f* +0 g +278.937 415.079 16.0575 0.2006 re +f* +1 g +294.994 415.079 3.613 0.2006 re +f* +0 g +298.607 415.079 10.6381 0.2006 re +f* +1 g +309.245 415.079 6.4231 0.2006 re +f* +0 g +315.669 415.079 17.4625 0.2006 re +f* +1 g +333.131 415.079 3.0108 0.2006 re +f* +0 g +336.142 415.079 8.631 0.2006 re +f* +1 g +344.773 415.079 0.8028 0.2006 re +f* +0 g +345.576 415.079 6.2224 0.2006 re +f* +1 g +351.798 415.079 4.8172 0.2006 re +f* +0.498 0 0.482 rg +356.615 415.079 7.0252 0.2006 re +f* +1 g +363.641 415.079 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 415.079 8.8317 0.2006 re +f* +1 g +376.085 415.079 2.8101 0.2006 re +f* +0.498 0 0.482 rg +378.895 415.079 8.6309 0.2006 re +f* +1 g +387.526 415.079 4.2151 0.2006 re +f* +0.498 0 0.482 rg +391.741 415.079 8.2295 0.2006 re +f* +1 g +399.971 415.079 3.4122 0.2006 re +f* +0.498 0 0.482 rg +403.383 415.079 9.8352 0.2006 re +f* +1 g +413.218 415.079 1.0036 0.2006 re +f* +0.498 0 0.482 rg +414.222 415.079 3.0108 0.2006 re +f* +0 g +250.435 415.28 20.8749 0.2005 re +f* +1 g +271.31 415.28 7.6273 0.2005 re +f* +0 g +278.937 415.28 16.0575 0.2005 re +f* +1 g +294.994 415.28 3.613 0.2005 re +f* +0 g +298.607 415.28 10.6381 0.2005 re +f* +1 g +309.245 415.28 6.4231 0.2005 re +f* +0 g +315.669 415.28 17.2618 0.2005 re +f* +1 g +332.93 415.28 3.0108 0.2005 re +f* +0 g +335.941 415.28 15.8569 0.2005 re +f* +1 g +351.798 415.28 5.0179 0.2005 re +f* +0.498 0 0.482 rg +356.816 415.28 6.8245 0.2005 re +f* +1 g +363.641 415.28 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 415.28 8.631 0.2005 re +f* +1 g +375.884 415.28 3.0108 0.2005 re +f* +0.498 0 0.482 rg +378.895 415.28 8.6309 0.2005 re +f* +1 g +387.526 415.28 4.2151 0.2005 re +f* +0.498 0 0.482 rg +391.741 415.28 8.0288 0.2005 re +f* +1 g +399.77 415.28 3.4122 0.2005 re +f* +0.498 0 0.482 rg +403.182 415.28 10.2367 0.2005 re +f* +1 g +413.419 415.28 0.8028 0.2005 re +f* +0.498 0 0.482 rg +414.222 415.28 3.2116 0.2005 re +f* +0 g +250.435 415.48 20.8749 0.2006 re +f* +1 g +271.31 415.48 7.6273 0.2006 re +f* +0 g +278.937 415.48 16.0575 0.2006 re +f* +1 g +294.994 415.48 3.613 0.2006 re +f* +0 g +298.607 415.48 10.6381 0.2006 re +f* +1 g +309.245 415.48 6.2223 0.2006 re +f* +0 g +315.468 415.48 17.2619 0.2006 re +f* +1 g +332.73 415.48 3.2115 0.2006 re +f* +0 g +335.941 415.48 16.0575 0.2006 re +f* +1 g +351.999 415.48 4.8173 0.2006 re +f* +0.498 0 0.482 rg +356.816 415.48 6.8245 0.2006 re +f* +1 g +363.641 415.48 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 415.48 8.4303 0.2006 re +f* +1 g +375.684 415.48 3.2115 0.2006 re +f* +0.498 0 0.482 rg +378.895 415.48 8.8316 0.2006 re +f* +1 g +387.727 415.48 4.0144 0.2006 re +f* +0.498 0 0.482 rg +391.741 415.48 8.0288 0.2006 re +f* +1 g +399.77 415.48 3.4122 0.2006 re +f* +0.498 0 0.482 rg +403.182 415.48 10.2367 0.2006 re +f* +1 g +413.419 415.48 1.0036 0.2006 re +f* +0.498 0 0.482 rg +414.422 415.48 3.0108 0.2006 re +f* +0 g +250.435 415.681 20.8749 0.2005 re +f* +1 g +271.31 415.681 7.6273 0.2005 re +f* +0 g +278.937 415.681 16.0575 0.2005 re +f* +1 g +294.994 415.681 3.613 0.2005 re +f* +0 g +298.607 415.681 10.6381 0.2005 re +f* +1 g +309.245 415.681 6.2223 0.2005 re +f* +0 g +315.468 415.681 17.0612 0.2005 re +f* +1 g +332.529 415.681 3.2115 0.2005 re +f* +0 g +335.74 415.681 16.2582 0.2005 re +f* +1 g +351.999 415.681 5.018 0.2005 re +f* +0.498 0 0.482 rg +357.017 415.681 6.6238 0.2005 re +f* +1 g +363.641 415.681 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 415.681 8.4303 0.2005 re +f* +1 g +375.684 415.681 3.2115 0.2005 re +f* +0.498 0 0.482 rg +378.895 415.681 8.8316 0.2005 re +f* +1 g +387.727 415.681 4.0144 0.2005 re +f* +0.498 0 0.482 rg +391.741 415.681 7.828 0.2005 re +f* +1 g +399.569 415.681 3.613 0.2005 re +f* +0.498 0 0.482 rg +403.182 415.681 10.4374 0.2005 re +f* +1 g +413.62 415.681 0.8029 0.2005 re +f* +0.498 0 0.482 rg +414.422 415.681 3.0108 0.2005 re +f* +0 g +250.435 415.881 20.8749 0.2006 re +f* +1 g +271.31 415.881 7.6273 0.2006 re +f* +0 g +278.937 415.881 16.0575 0.2006 re +f* +1 g +294.994 415.881 3.613 0.2006 re +f* +0 g +298.607 415.881 10.6381 0.2006 re +f* +1 g +309.245 415.881 6.2223 0.2006 re +f* +0 g +315.468 415.881 16.8604 0.2006 re +f* +1 g +332.328 415.881 3.4123 0.2006 re +f* +0 g +335.74 415.881 16.2582 0.2006 re +f* +1 g +351.999 415.881 5.018 0.2006 re +f* +0.498 0 0.482 rg +357.017 415.881 6.6238 0.2006 re +f* +1 g +363.641 415.881 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 415.881 8.2295 0.2006 re +f* +1 g +375.483 415.881 3.2116 0.2006 re +f* +0.498 0 0.482 rg +378.695 415.881 9.0323 0.2006 re +f* +1 g +387.727 415.881 4.0144 0.2006 re +f* +0.498 0 0.482 rg +391.741 415.881 7.828 0.2006 re +f* +1 g +399.569 415.881 3.613 0.2006 re +f* +0.498 0 0.482 rg +403.182 415.881 10.4374 0.2006 re +f* +1 g +413.62 415.881 1.0036 0.2006 re +f* +0.498 0 0.482 rg +414.623 415.881 2.8101 0.2006 re +f* +0 g +250.435 416.082 20.8749 0.2006 re +f* +1 g +271.31 416.082 7.6273 0.2006 re +f* +0 g +278.937 416.082 16.0575 0.2006 re +f* +1 g +294.994 416.082 3.613 0.2006 re +f* +0 g +298.607 416.082 10.6381 0.2006 re +f* +1 g +309.245 416.082 6.2223 0.2006 re +f* +0 g +315.468 416.082 16.8604 0.2006 re +f* +1 g +332.328 416.082 3.2116 0.2006 re +f* +0 g +335.54 416.082 16.4589 0.2006 re +f* +1 g +351.999 416.082 5.2187 0.2006 re +f* +0.498 0 0.482 rg +357.217 416.082 6.4231 0.2006 re +f* +1 g +363.641 416.082 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 416.082 8.2295 0.2006 re +f* +1 g +375.483 416.082 3.2116 0.2006 re +f* +0.498 0 0.482 rg +378.695 416.082 9.0323 0.2006 re +f* +1 g +387.727 416.082 4.0144 0.2006 re +f* +0.498 0 0.482 rg +391.741 416.082 7.6273 0.2006 re +f* +1 g +399.368 416.082 3.613 0.2006 re +f* +0.498 0 0.482 rg +402.981 416.082 10.6381 0.2006 re +f* +1 g +413.62 416.082 1.0036 0.2006 re +f* +0.498 0 0.482 rg +414.623 416.082 2.8101 0.2006 re +f* +0 g +250.435 416.282 20.8749 0.2005 re +f* +1 g +271.31 416.282 7.6273 0.2005 re +f* +0 g +278.937 416.282 16.0575 0.2005 re +f* +1 g +294.994 416.282 3.613 0.2005 re +f* +0 g +298.607 416.282 10.6381 0.2005 re +f* +1 g +309.245 416.282 6.0216 0.2005 re +f* +0 g +315.267 416.282 16.8604 0.2005 re +f* +1 g +332.127 416.282 3.4123 0.2005 re +f* +0 g +335.54 416.282 16.6597 0.2005 re +f* +1 g +352.2 416.282 5.0179 0.2005 re +f* +0.498 0 0.482 rg +357.217 416.282 6.4231 0.2005 re +f* +1 g +363.641 416.282 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 416.282 8.0288 0.2005 re +f* +1 g +375.282 416.282 3.4123 0.2005 re +f* +0.498 0 0.482 rg +378.695 416.282 9.2331 0.2005 re +f* +1 g +387.928 416.282 3.8136 0.2005 re +f* +0.498 0 0.482 rg +391.741 416.282 7.6273 0.2005 re +f* +1 g +399.368 416.282 3.613 0.2005 re +f* +0.498 0 0.482 rg +402.981 416.282 10.8388 0.2005 re +f* +1 g +413.82 416.282 0.8029 0.2005 re +f* +0.498 0 0.482 rg +414.623 416.282 2.8101 0.2005 re +f* +0 g +250.435 416.483 20.8749 0.2005 re +f* +1 g +271.31 416.483 7.6273 0.2005 re +f* +0 g +278.937 416.483 16.0575 0.2005 re +f* +1 g +294.994 416.483 3.613 0.2005 re +f* +0 g +298.607 416.483 10.6381 0.2005 re +f* +1 g +309.245 416.483 6.0216 0.2005 re +f* +0 g +315.267 416.483 16.6597 0.2005 re +f* +1 g +331.927 416.483 3.613 0.2005 re +f* +0 g +335.54 416.483 16.6597 0.2005 re +f* +1 g +352.2 416.483 5.2187 0.2005 re +f* +0.498 0 0.482 rg +357.418 416.483 6.2223 0.2005 re +f* +1 g +363.641 416.483 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 416.483 8.0288 0.2005 re +f* +1 g +375.282 416.483 3.4123 0.2005 re +f* +0.498 0 0.482 rg +378.695 416.483 9.2331 0.2005 re +f* +1 g +387.928 416.483 3.8136 0.2005 re +f* +0.498 0 0.482 rg +391.741 416.483 7.4266 0.2005 re +f* +1 g +399.168 416.483 3.8137 0.2005 re +f* +0.498 0 0.482 rg +402.981 416.483 10.8388 0.2005 re +f* +1 g +413.82 416.483 0.2008 0.2005 re +f* +0.498 0 0.482 rg +414.021 416.483 3.4122 0.2005 re +f* +0 g +250.435 416.683 20.8749 0.2006 re +f* +1 g +271.31 416.683 7.6273 0.2006 re +f* +0 g +278.937 416.683 16.0575 0.2006 re +f* +1 g +294.994 416.683 3.613 0.2006 re +f* +0 g +298.607 416.683 10.6381 0.2006 re +f* +1 g +309.245 416.683 6.0216 0.2006 re +f* +0 g +315.267 416.683 16.6597 0.2006 re +f* +1 g +331.927 416.683 3.4123 0.2006 re +f* +0 g +335.339 416.683 16.8604 0.2006 re +f* +1 g +352.2 416.683 5.2187 0.2006 re +f* +0.498 0 0.482 rg +357.418 416.683 6.2223 0.2006 re +f* +1 g +363.641 416.683 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 416.683 7.8281 0.2006 re +f* +1 g +375.081 416.683 3.613 0.2006 re +f* +0.498 0 0.482 rg +378.695 416.683 9.2331 0.2006 re +f* +1 g +387.928 416.683 3.8136 0.2006 re +f* +0.498 0 0.482 rg +391.741 416.683 7.4266 0.2006 re +f* +1 g +399.168 416.683 3.8137 0.2006 re +f* +0.498 0 0.482 rg +402.981 416.683 14.4518 0.2006 re +f* +0 g +250.234 416.884 21.0756 0.2006 re +f* +1 g +271.31 416.884 7.6273 0.2006 re +f* +0 g +278.937 416.884 16.0575 0.2006 re +f* +1 g +294.994 416.884 3.613 0.2006 re +f* +0 g +298.607 416.884 10.6381 0.2006 re +f* +1 g +309.245 416.884 6.0216 0.2006 re +f* +0 g +315.267 416.884 16.459 0.2006 re +f* +1 g +331.726 416.884 3.613 0.2006 re +f* +0 g +335.339 416.884 16.8604 0.2006 re +f* +1 g +352.2 416.884 5.4194 0.2006 re +f* +0.498 0 0.482 rg +357.619 416.884 6.0216 0.2006 re +f* +1 g +363.641 416.884 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 416.884 7.8281 0.2006 re +f* +1 g +375.081 416.884 3.613 0.2006 re +f* +0.498 0 0.482 rg +378.695 416.884 9.2331 0.2006 re +f* +1 g +387.928 416.884 3.8136 0.2006 re +f* +0.498 0 0.482 rg +391.741 416.884 7.4266 0.2006 re +f* +1 g +399.168 416.884 3.8137 0.2006 re +f* +0.498 0 0.482 rg +402.981 416.884 14.4518 0.2006 re +f* +0 g +250.234 417.085 14.2511 0.2005 re +f* +1 g +264.485 417.085 25.8928 0.2005 re +f* +0 g +290.378 417.085 4.6165 0.2005 re +f* +1 g +294.994 417.085 3.613 0.2005 re +f* +0 g +298.607 417.085 10.6381 0.2005 re +f* +1 g +309.245 417.085 5.8209 0.2005 re +f* +0 g +315.066 417.085 16.6597 0.2005 re +f* +1 g +331.726 417.085 3.613 0.2005 re +f* +0 g +335.339 417.085 17.0611 0.2005 re +f* +1 g +352.4 417.085 5.2187 0.2005 re +f* +0.498 0 0.482 rg +357.619 417.085 6.0216 0.2005 re +f* +1 g +363.641 417.085 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 417.085 7.6274 0.2005 re +f* +1 g +374.881 417.085 3.6129 0.2005 re +f* +0.498 0 0.482 rg +378.494 417.085 9.4339 0.2005 re +f* +1 g +387.928 417.085 3.8136 0.2005 re +f* +0.498 0 0.482 rg +391.741 417.085 7.2259 0.2005 re +f* +1 g +398.967 417.085 3.8137 0.2005 re +f* +0.498 0 0.482 rg +402.781 417.085 14.6525 0.2005 re +f* +0 g +250.234 417.285 14.2511 0.2005 re +f* +1 g +264.485 417.285 25.8928 0.2005 re +f* +0 g +290.378 417.285 4.6165 0.2005 re +f* +1 g +294.994 417.285 3.613 0.2005 re +f* +0 g +298.607 417.285 10.6381 0.2005 re +f* +1 g +309.245 417.285 5.8209 0.2005 re +f* +0 g +315.066 417.285 16.459 0.2005 re +f* +1 g +331.525 417.285 3.6129 0.2005 re +f* +0 g +335.138 417.285 17.2619 0.2005 re +f* +1 g +352.4 417.285 5.4194 0.2005 re +f* +0.498 0 0.482 rg +357.82 417.285 5.8209 0.2005 re +f* +1 g +363.641 417.285 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 417.285 7.6274 0.2005 re +f* +1 g +374.881 417.285 3.6129 0.2005 re +f* +0.498 0 0.482 rg +378.494 417.285 9.6345 0.2005 re +f* +1 g +388.128 417.285 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 417.285 7.2259 0.2005 re +f* +1 g +398.967 417.285 3.8137 0.2005 re +f* +0.498 0 0.482 rg +402.781 417.285 14.8532 0.2005 re +f* +0 g +250.234 417.486 14.2511 0.2006 re +f* +1 g +264.485 417.486 25.8928 0.2006 re +f* +0 g +290.378 417.486 4.6165 0.2006 re +f* +1 g +294.994 417.486 3.613 0.2006 re +f* +0 g +298.607 417.486 10.6381 0.2006 re +f* +1 g +309.245 417.486 5.8209 0.2006 re +f* +0 g +315.066 417.486 16.459 0.2006 re +f* +1 g +331.525 417.486 3.6129 0.2006 re +f* +0 g +335.138 417.486 17.2619 0.2006 re +f* +1 g +352.4 417.486 5.4194 0.2006 re +f* +0.498 0 0.482 rg +357.82 417.486 5.8209 0.2006 re +f* +1 g +363.641 417.486 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 417.486 7.6274 0.2006 re +f* +1 g +374.881 417.486 3.6129 0.2006 re +f* +0.498 0 0.482 rg +378.494 417.486 9.6345 0.2006 re +f* +1 g +388.128 417.486 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 417.486 7.2259 0.2006 re +f* +1 g +398.967 417.486 3.8137 0.2006 re +f* +0.498 0 0.482 rg +402.781 417.486 14.8532 0.2006 re +f* +0 g +250.234 417.686 14.2511 0.2006 re +f* +1 g +264.485 417.686 25.8928 0.2006 re +f* +0 g +290.378 417.686 4.6165 0.2006 re +f* +1 g +294.994 417.686 3.613 0.2006 re +f* +0 g +298.607 417.686 10.6381 0.2006 re +f* +1 g +309.245 417.686 5.8209 0.2006 re +f* +0 g +315.066 417.686 16.2582 0.2006 re +f* +1 g +331.325 417.686 3.8137 0.2006 re +f* +0 g +335.138 417.686 17.2619 0.2006 re +f* +1 g +352.4 417.686 5.6201 0.2006 re +f* +0.498 0 0.482 rg +358.02 417.686 5.6202 0.2006 re +f* +1 g +363.641 417.686 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 417.686 7.4267 0.2006 re +f* +1 g +374.68 417.686 3.8136 0.2006 re +f* +0.498 0 0.482 rg +378.494 417.686 9.6345 0.2006 re +f* +1 g +388.128 417.686 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 417.686 7.0252 0.2006 re +f* +1 g +398.766 417.686 4.0144 0.2006 re +f* +0.498 0 0.482 rg +402.781 417.686 14.8532 0.2006 re +f* +0 g +250.234 417.887 14.2511 0.2006 re +f* +1 g +264.485 417.887 25.8928 0.2006 re +f* +0 g +290.378 417.887 4.6165 0.2006 re +f* +1 g +294.994 417.887 3.613 0.2006 re +f* +0 g +298.607 417.887 10.6381 0.2006 re +f* +1 g +309.245 417.887 5.6201 0.2006 re +f* +0 g +314.866 417.887 16.459 0.2006 re +f* +1 g +331.325 417.887 3.8137 0.2006 re +f* +0 g +335.138 417.887 17.2619 0.2006 re +f* +1 g +352.4 417.887 5.6201 0.2006 re +f* +0.498 0 0.482 rg +358.02 417.887 5.6202 0.2006 re +f* +1 g +363.641 417.887 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 417.887 7.4267 0.2006 re +f* +1 g +374.68 417.887 3.8136 0.2006 re +f* +0.498 0 0.482 rg +378.494 417.887 9.6345 0.2006 re +f* +1 g +388.128 417.887 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 417.887 7.0252 0.2006 re +f* +1 g +398.766 417.887 4.0144 0.2006 re +f* +0.498 0 0.482 rg +402.781 417.887 14.8532 0.2006 re +f* +0 g +250.234 418.087 14.2511 0.2006 re +f* +1 g +264.485 418.087 25.8928 0.2006 re +f* +0 g +290.378 418.087 4.6165 0.2006 re +f* +1 g +294.994 418.087 3.613 0.2006 re +f* +0 g +298.607 418.087 10.6381 0.2006 re +f* +1 g +309.245 418.087 5.6201 0.2006 re +f* +0 g +314.866 418.087 16.459 0.2006 re +f* +1 g +331.325 418.087 3.8137 0.2006 re +f* +0 g +335.138 418.087 17.4626 0.2006 re +f* +1 g +352.601 418.087 5.6201 0.2006 re +f* +0.498 0 0.482 rg +358.221 418.087 5.4195 0.2006 re +f* +1 g +363.641 418.087 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 418.087 7.4267 0.2006 re +f* +1 g +374.68 418.087 3.8136 0.2006 re +f* +0.498 0 0.482 rg +378.494 418.087 9.6345 0.2006 re +f* +1 g +388.128 418.087 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 418.087 7.0252 0.2006 re +f* +1 g +398.766 418.087 4.0144 0.2006 re +f* +0.498 0 0.482 rg +402.781 418.087 14.8532 0.2006 re +f* +0 g +250.234 418.288 14.2511 0.2005 re +f* +1 g +264.485 418.288 25.8928 0.2005 re +f* +0 g +290.378 418.288 4.6165 0.2005 re +f* +1 g +294.994 418.288 3.613 0.2005 re +f* +0 g +298.607 418.288 10.6381 0.2005 re +f* +1 g +309.245 418.288 5.6201 0.2005 re +f* +0 g +314.866 418.288 16.2583 0.2005 re +f* +1 g +331.124 418.288 4.0144 0.2005 re +f* +0 g +335.138 418.288 17.4626 0.2005 re +f* +1 g +352.601 418.288 5.6201 0.2005 re +f* +0.498 0 0.482 rg +358.221 418.288 5.4195 0.2005 re +f* +1 g +363.641 418.288 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 418.288 7.2259 0.2005 re +f* +1 g +374.479 418.288 4.0144 0.2005 re +f* +0.498 0 0.482 rg +378.494 418.288 9.6345 0.2005 re +f* +1 g +388.128 418.288 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 418.288 7.0252 0.2005 re +f* +1 g +398.766 418.288 4.0144 0.2005 re +f* +0.498 0 0.482 rg +402.781 418.288 14.8532 0.2005 re +f* +0 g +250.234 418.489 14.2511 0.2005 re +f* +1 g +264.485 418.489 25.8928 0.2005 re +f* +0 g +290.378 418.489 4.6165 0.2005 re +f* +1 g +294.994 418.489 3.613 0.2005 re +f* +0 g +298.607 418.489 10.8389 0.2005 re +f* +1 g +309.446 418.489 5.4193 0.2005 re +f* +0 g +314.866 418.489 16.2583 0.2005 re +f* +1 g +331.124 418.489 3.8137 0.2005 re +f* +0 g +334.938 418.489 17.6633 0.2005 re +f* +1 g +352.601 418.489 5.6201 0.2005 re +f* +0.498 0 0.482 rg +358.221 418.489 5.4195 0.2005 re +f* +1 g +363.641 418.489 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 418.489 7.2259 0.2005 re +f* +1 g +374.479 418.489 4.0144 0.2005 re +f* +0.498 0 0.482 rg +378.494 418.489 9.6345 0.2005 re +f* +1 g +388.128 418.489 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 418.489 7.0252 0.2005 re +f* +1 g +398.766 418.489 4.0144 0.2005 re +f* +0.498 0 0.482 rg +402.781 418.489 14.8532 0.2005 re +f* +0 g +250.234 418.689 14.2511 0.2006 re +f* +1 g +264.485 418.689 25.8928 0.2006 re +f* +0 g +290.378 418.689 4.6165 0.2006 re +f* +1 g +294.994 418.689 3.613 0.2006 re +f* +0 g +298.607 418.689 10.8389 0.2006 re +f* +1 g +309.446 418.689 5.4193 0.2006 re +f* +0 g +314.866 418.689 16.2583 0.2006 re +f* +1 g +331.124 418.689 3.8137 0.2006 re +f* +0 g +334.938 418.689 17.6633 0.2006 re +f* +1 g +352.601 418.689 5.8209 0.2006 re +f* +0.498 0 0.482 rg +358.422 418.689 5.2187 0.2006 re +f* +1 g +363.641 418.689 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 418.689 7.2259 0.2006 re +f* +1 g +374.479 418.689 4.0144 0.2006 re +f* +0.498 0 0.482 rg +378.494 418.689 9.6345 0.2006 re +f* +1 g +388.128 418.689 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 418.689 6.8244 0.2006 re +f* +1 g +398.566 418.689 4.2152 0.2006 re +f* +0.498 0 0.482 rg +402.781 418.689 14.8532 0.2006 re +f* +0 g +250.234 418.89 14.2511 0.2006 re +f* +1 g +264.485 418.89 25.8928 0.2006 re +f* +0 g +290.378 418.89 4.6165 0.2006 re +f* +1 g +294.994 418.89 3.613 0.2006 re +f* +0 g +298.607 418.89 10.8389 0.2006 re +f* +1 g +309.446 418.89 5.4193 0.2006 re +f* +0 g +314.866 418.89 16.0576 0.2006 re +f* +1 g +330.923 418.89 4.0144 0.2006 re +f* +0 g +334.938 418.89 17.6633 0.2006 re +f* +1 g +352.601 418.89 5.8209 0.2006 re +f* +0.498 0 0.482 rg +358.422 418.89 5.2187 0.2006 re +f* +1 g +363.641 418.89 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 418.89 7.2259 0.2006 re +f* +1 g +374.479 418.89 4.0144 0.2006 re +f* +0.498 0 0.482 rg +378.494 418.89 9.6345 0.2006 re +f* +1 g +388.128 418.89 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 418.89 6.8244 0.2006 re +f* +1 g +398.566 418.89 4.2152 0.2006 re +f* +0.498 0 0.482 rg +402.781 418.89 14.8532 0.2006 re +f* +0 g +250.234 419.09 14.2511 0.2005 re +f* +1 g +264.485 419.09 25.8928 0.2005 re +f* +0 g +290.378 419.09 4.6165 0.2005 re +f* +1 g +294.994 419.09 3.613 0.2005 re +f* +0 g +298.607 419.09 10.8389 0.2005 re +f* +1 g +309.446 419.09 5.4193 0.2005 re +f* +0 g +314.866 419.09 16.0576 0.2005 re +f* +1 g +330.923 419.09 4.0144 0.2005 re +f* +0 g +334.938 419.09 17.6633 0.2005 re +f* +1 g +352.601 419.09 5.8209 0.2005 re +f* +0.498 0 0.482 rg +358.422 419.09 5.2187 0.2005 re +f* +1 g +363.641 419.09 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 419.09 7.2259 0.2005 re +f* +1 g +374.479 419.09 4.0144 0.2005 re +f* +0.498 0 0.482 rg +378.494 419.09 9.6345 0.2005 re +f* +1 g +388.128 419.09 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 419.09 6.8244 0.2005 re +f* +1 g +398.566 419.09 4.2152 0.2005 re +f* +0.498 0 0.482 rg +402.781 419.09 14.8532 0.2005 re +f* +0 g +250.234 419.291 14.2511 0.2006 re +f* +1 g +264.485 419.291 25.8928 0.2006 re +f* +0 g +290.378 419.291 4.6165 0.2006 re +f* +1 g +294.994 419.291 3.613 0.2006 re +f* +0 g +298.607 419.291 10.8389 0.2006 re +f* +1 g +309.446 419.291 5.4193 0.2006 re +f* +0 g +314.866 419.291 16.0576 0.2006 re +f* +1 g +330.923 419.291 4.0144 0.2006 re +f* +0 g +334.938 419.291 17.6633 0.2006 re +f* +1 g +352.601 419.291 6.0216 0.2006 re +f* +0.498 0 0.482 rg +358.623 419.291 5.018 0.2006 re +f* +1 g +363.641 419.291 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 419.291 7.0252 0.2006 re +f* +1 g +374.279 419.291 4.2151 0.2006 re +f* +0.498 0 0.482 rg +378.494 419.291 9.6345 0.2006 re +f* +1 g +388.128 419.291 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 419.291 6.8244 0.2006 re +f* +1 g +398.566 419.291 4.2152 0.2006 re +f* +0.498 0 0.482 rg +402.781 419.291 14.8532 0.2006 re +f* +0 g +250.234 419.491 14.2511 0.2005 re +f* +1 g +264.485 419.491 25.8928 0.2005 re +f* +0 g +290.378 419.491 4.6165 0.2005 re +f* +1 g +294.994 419.491 3.613 0.2005 re +f* +0 g +298.607 419.491 10.8389 0.2005 re +f* +1 g +309.446 419.491 5.2187 0.2005 re +f* +0 g +314.665 419.491 16.2582 0.2005 re +f* +1 g +330.923 419.491 4.0144 0.2005 re +f* +0 g +334.938 419.491 17.6633 0.2005 re +f* +1 g +352.601 419.491 6.0216 0.2005 re +f* +0.498 0 0.482 rg +358.623 419.491 5.018 0.2005 re +f* +1 g +363.641 419.491 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 419.491 7.0252 0.2005 re +f* +1 g +374.279 419.491 4.2151 0.2005 re +f* +0.498 0 0.482 rg +378.494 419.491 9.6345 0.2005 re +f* +1 g +388.128 419.491 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 419.491 6.8244 0.2005 re +f* +1 g +398.566 419.491 4.2152 0.2005 re +f* +0.498 0 0.482 rg +402.781 419.491 14.8532 0.2005 re +f* +0 g +250.234 419.692 14.2511 0.2006 re +f* +1 g +264.485 419.692 25.8928 0.2006 re +f* +0 g +290.378 419.692 4.6165 0.2006 re +f* +1 g +294.994 419.692 3.613 0.2006 re +f* +0 g +298.607 419.692 10.8389 0.2006 re +f* +1 g +309.446 419.692 5.2187 0.2006 re +f* +0 g +314.665 419.692 16.2582 0.2006 re +f* +1 g +330.923 419.692 4.0144 0.2006 re +f* +0 g +334.938 419.692 17.6633 0.2006 re +f* +1 g +352.601 419.692 6.0216 0.2006 re +f* +0.498 0 0.482 rg +358.623 419.692 5.018 0.2006 re +f* +1 g +363.641 419.692 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 419.692 7.0252 0.2006 re +f* +1 g +374.279 419.692 4.2151 0.2006 re +f* +0.498 0 0.482 rg +378.494 419.692 9.6345 0.2006 re +f* +1 g +388.128 419.692 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 419.692 6.8244 0.2006 re +f* +1 g +398.566 419.692 4.2152 0.2006 re +f* +0.498 0 0.482 rg +402.781 419.692 14.8532 0.2006 re +f* +0 g +250.234 419.892 14.2511 0.2005 re +f* +1 g +264.485 419.892 6.6237 0.2005 re +f* +0 g +271.109 419.892 0.2008 0.2005 re +f* +1 g +271.31 419.892 7.6273 0.2005 re +f* +0 g +278.937 419.892 0.2007 0.2005 re +f* +1 g +279.138 419.892 11.2403 0.2005 re +f* +0 g +290.378 419.892 4.6165 0.2005 re +f* +1 g +294.994 419.892 3.613 0.2005 re +f* +0 g +298.607 419.892 10.8389 0.2005 re +f* +1 g +309.446 419.892 5.2187 0.2005 re +f* +0 g +314.665 419.892 16.0575 0.2005 re +f* +1 g +330.722 419.892 4.2151 0.2005 re +f* +0 g +334.938 419.892 17.6633 0.2005 re +f* +1 g +352.601 419.892 6.2223 0.2005 re +f* +0.498 0 0.482 rg +358.823 419.892 4.8173 0.2005 re +f* +1 g +363.641 419.892 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 419.892 7.0252 0.2005 re +f* +1 g +374.279 419.892 4.2151 0.2005 re +f* +0.498 0 0.482 rg +378.494 419.892 9.6345 0.2005 re +f* +1 g +388.128 419.892 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 419.892 6.8244 0.2005 re +f* +1 g +398.566 419.892 4.2152 0.2005 re +f* +0.498 0 0.482 rg +402.781 419.892 14.8532 0.2005 re +f* +0 g +250.234 420.093 21.0756 0.2006 re +f* +1 g +271.31 420.093 7.6273 0.2006 re +f* +0 g +278.937 420.093 16.0575 0.2006 re +f* +1 g +294.994 420.093 3.613 0.2006 re +f* +0 g +298.607 420.093 11.0396 0.2006 re +f* +1 g +309.647 420.093 5.018 0.2006 re +f* +0 g +314.665 420.093 16.0575 0.2006 re +f* +1 g +330.722 420.093 4.2151 0.2006 re +f* +0 g +334.938 420.093 17.6633 0.2006 re +f* +1 g +352.601 420.093 6.2223 0.2006 re +f* +0.498 0 0.482 rg +358.823 420.093 4.8173 0.2006 re +f* +1 g +363.641 420.093 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 420.093 7.0252 0.2006 re +f* +1 g +374.279 420.093 4.2151 0.2006 re +f* +0.498 0 0.482 rg +378.494 420.093 9.6345 0.2006 re +f* +1 g +388.128 420.093 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 420.093 6.8244 0.2006 re +f* +1 g +398.566 420.093 4.2152 0.2006 re +f* +0.498 0 0.482 rg +402.781 420.093 14.8532 0.2006 re +f* +0 g +250.234 420.294 21.0756 0.2005 re +f* +1 g +271.31 420.294 7.6273 0.2005 re +f* +0 g +278.937 420.294 16.0575 0.2005 re +f* +1 g +294.994 420.294 3.613 0.2005 re +f* +0 g +298.607 420.294 11.0396 0.2005 re +f* +1 g +309.647 420.294 5.018 0.2005 re +f* +0 g +314.665 420.294 16.0575 0.2005 re +f* +1 g +330.722 420.294 4.2151 0.2005 re +f* +0 g +334.938 420.294 17.8641 0.2005 re +f* +1 g +352.802 420.294 6.0215 0.2005 re +f* +0.498 0 0.482 rg +358.823 420.294 4.8173 0.2005 re +f* +1 g +363.641 420.294 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 420.294 7.0252 0.2005 re +f* +1 g +374.279 420.294 4.2151 0.2005 re +f* +0.498 0 0.482 rg +378.494 420.294 9.6345 0.2005 re +f* +1 g +388.128 420.294 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 420.294 6.8244 0.2005 re +f* +1 g +398.566 420.294 4.2152 0.2005 re +f* +0.498 0 0.482 rg +402.781 420.294 14.8532 0.2005 re +f* +0 g +250.234 420.494 21.0756 0.2006 re +f* +1 g +271.31 420.494 7.6273 0.2006 re +f* +0 g +278.937 420.494 16.0575 0.2006 re +f* +1 g +294.994 420.494 3.613 0.2006 re +f* +0 g +298.607 420.494 11.0396 0.2006 re +f* +1 g +309.647 420.494 5.018 0.2006 re +f* +0 g +314.665 420.494 16.0575 0.2006 re +f* +1 g +330.722 420.494 4.2151 0.2006 re +f* +0 g +334.938 420.494 17.8641 0.2006 re +f* +1 g +352.802 420.494 6.0215 0.2006 re +f* +0.498 0 0.482 rg +358.823 420.494 4.8173 0.2006 re +f* +1 g +363.641 420.494 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 420.494 7.0252 0.2006 re +f* +1 g +374.279 420.494 4.2151 0.2006 re +f* +0.498 0 0.482 rg +378.494 420.494 9.6345 0.2006 re +f* +1 g +388.128 420.494 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 420.494 6.8244 0.2006 re +f* +1 g +398.566 420.494 4.2152 0.2006 re +f* +0.498 0 0.482 rg +402.781 420.494 14.8532 0.2006 re +f* +0 g +250.234 420.695 21.0756 0.2006 re +f* +1 g +271.31 420.695 7.6273 0.2006 re +f* +0 g +278.937 420.695 16.0575 0.2006 re +f* +1 g +294.994 420.695 3.613 0.2006 re +f* +0 g +298.607 420.695 11.0396 0.2006 re +f* +1 g +309.647 420.695 5.018 0.2006 re +f* +0 g +314.665 420.695 16.0575 0.2006 re +f* +1 g +330.722 420.695 4.2151 0.2006 re +f* +0 g +334.938 420.695 17.8641 0.2006 re +f* +1 g +352.802 420.695 6.2222 0.2006 re +f* +0.498 0 0.482 rg +359.024 420.695 4.6166 0.2006 re +f* +1 g +363.641 420.695 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 420.695 7.0252 0.2006 re +f* +1 g +374.279 420.695 4.2151 0.2006 re +f* +0.498 0 0.482 rg +378.494 420.695 9.6345 0.2006 re +f* +1 g +388.128 420.695 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 420.695 6.8244 0.2006 re +f* +1 g +398.566 420.695 4.2152 0.2006 re +f* +0.498 0 0.482 rg +402.781 420.695 14.8532 0.2006 re +f* +0 g +250.234 420.895 21.0756 0.2006 re +f* +1 g +271.31 420.895 7.6273 0.2006 re +f* +0 g +278.937 420.895 16.0575 0.2006 re +f* +1 g +294.994 420.895 3.613 0.2006 re +f* +0 g +298.607 420.895 11.0396 0.2006 re +f* +1 g +309.647 420.895 5.018 0.2006 re +f* +0 g +314.665 420.895 16.0575 0.2006 re +f* +1 g +330.722 420.895 4.2151 0.2006 re +f* +0 g +334.938 420.895 17.8641 0.2006 re +f* +1 g +352.802 420.895 6.2222 0.2006 re +f* +0.498 0 0.482 rg +359.024 420.895 4.6166 0.2006 re +f* +1 g +363.641 420.895 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 420.895 7.0252 0.2006 re +f* +1 g +374.279 420.895 4.2151 0.2006 re +f* +0.498 0 0.482 rg +378.494 420.895 9.6345 0.2006 re +f* +1 g +388.128 420.895 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 420.895 6.8244 0.2006 re +f* +1 g +398.566 420.895 4.2152 0.2006 re +f* +0.498 0 0.482 rg +402.781 420.895 14.8532 0.2006 re +f* +0 g +250.234 421.096 21.0756 0.2005 re +f* +1 g +271.31 421.096 7.6273 0.2005 re +f* +0 g +278.937 421.096 16.0575 0.2005 re +f* +1 g +294.994 421.096 3.613 0.2005 re +f* +0 g +298.607 421.096 11.2403 0.2005 re +f* +1 g +309.848 421.096 4.8173 0.2005 re +f* +0 g +314.665 421.096 16.0575 0.2005 re +f* +1 g +330.722 421.096 4.2151 0.2005 re +f* +0 g +334.938 421.096 17.8641 0.2005 re +f* +1 g +352.802 421.096 6.2222 0.2005 re +f* +0.498 0 0.482 rg +359.024 421.096 4.6166 0.2005 re +f* +1 g +363.641 421.096 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 421.096 7.0252 0.2005 re +f* +1 g +374.279 421.096 4.2151 0.2005 re +f* +0.498 0 0.482 rg +378.494 421.096 9.6345 0.2005 re +f* +1 g +388.128 421.096 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 421.096 6.8244 0.2005 re +f* +1 g +398.566 421.096 4.2152 0.2005 re +f* +0.498 0 0.482 rg +402.781 421.096 14.8532 0.2005 re +f* +0 g +250.234 421.296 21.0756 0.2005 re +f* +1 g +271.31 421.296 7.6273 0.2005 re +f* +0 g +278.937 421.296 16.0575 0.2005 re +f* +1 g +294.994 421.296 3.613 0.2005 re +f* +0 g +298.607 421.296 11.2403 0.2005 re +f* +1 g +309.848 421.296 4.8173 0.2005 re +f* +0 g +314.665 421.296 16.0575 0.2005 re +f* +1 g +330.722 421.296 4.2151 0.2005 re +f* +0 g +334.938 421.296 17.6633 0.2005 re +f* +1 g +352.601 421.296 6.423 0.2005 re +f* +0.498 0 0.482 rg +359.024 421.296 4.6166 0.2005 re +f* +1 g +363.641 421.296 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 421.296 7.0252 0.2005 re +f* +1 g +374.279 421.296 4.2151 0.2005 re +f* +0.498 0 0.482 rg +378.494 421.296 9.6345 0.2005 re +f* +1 g +388.128 421.296 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 421.296 6.8244 0.2005 re +f* +1 g +398.566 421.296 4.2152 0.2005 re +f* +0.498 0 0.482 rg +402.781 421.296 14.8532 0.2005 re +f* +0 g +250.234 421.497 21.0756 0.2006 re +f* +1 g +271.31 421.497 7.6273 0.2006 re +f* +0 g +278.937 421.497 16.0575 0.2006 re +f* +1 g +294.994 421.497 3.613 0.2006 re +f* +0 g +298.607 421.497 11.2403 0.2006 re +f* +1 g +309.848 421.497 4.8173 0.2006 re +f* +0 g +314.665 421.497 16.0575 0.2006 re +f* +1 g +330.722 421.497 4.2151 0.2006 re +f* +0 g +334.938 421.497 17.6633 0.2006 re +f* +1 g +352.601 421.497 6.6237 0.2006 re +f* +0.498 0 0.482 rg +359.225 421.497 4.4159 0.2006 re +f* +1 g +363.641 421.497 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 421.497 7.0252 0.2006 re +f* +1 g +374.279 421.497 4.2151 0.2006 re +f* +0.498 0 0.482 rg +378.494 421.497 9.6345 0.2006 re +f* +1 g +388.128 421.497 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 421.497 6.8244 0.2006 re +f* +1 g +398.566 421.497 4.2152 0.2006 re +f* +0.498 0 0.482 rg +402.781 421.497 14.8532 0.2006 re +f* +0 g +250.234 421.697 21.0756 0.2006 re +f* +1 g +271.31 421.697 7.6273 0.2006 re +f* +0 g +278.937 421.697 16.0575 0.2006 re +f* +1 g +294.994 421.697 3.613 0.2006 re +f* +0 g +298.607 421.697 11.2403 0.2006 re +f* +1 g +309.848 421.697 4.8173 0.2006 re +f* +0 g +314.665 421.697 16.0575 0.2006 re +f* +1 g +330.722 421.697 4.2151 0.2006 re +f* +0 g +334.938 421.697 17.6633 0.2006 re +f* +1 g +352.601 421.697 6.6237 0.2006 re +f* +0.498 0 0.482 rg +359.225 421.697 4.4159 0.2006 re +f* +1 g +363.641 421.697 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 421.697 7.0252 0.2006 re +f* +1 g +374.279 421.697 4.2151 0.2006 re +f* +0.498 0 0.482 rg +378.494 421.697 9.6345 0.2006 re +f* +1 g +388.128 421.697 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 421.697 6.8244 0.2006 re +f* +1 g +398.566 421.697 4.2152 0.2006 re +f* +0.498 0 0.482 rg +402.781 421.697 12.0431 0.2006 re +f* +1 g +414.824 421.697 0.2008 0.2006 re +f* +0.498 0 0.482 rg +415.025 421.697 2.6093 0.2006 re +f* +0 g +250.234 421.898 21.0756 0.2005 re +f* +1 g +271.31 421.898 7.6273 0.2005 re +f* +0 g +278.937 421.898 16.0575 0.2005 re +f* +1 g +294.994 421.898 3.613 0.2005 re +f* +0 g +298.607 421.898 11.441 0.2005 re +f* +1 g +310.048 421.898 4.6166 0.2005 re +f* +0 g +314.665 421.898 16.0575 0.2005 re +f* +1 g +330.722 421.898 4.2151 0.2005 re +f* +0 g +334.938 421.898 17.6633 0.2005 re +f* +1 g +352.601 421.898 6.6237 0.2005 re +f* +0.498 0 0.482 rg +359.225 421.898 4.4159 0.2005 re +f* +1 g +363.641 421.898 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 421.898 7.2259 0.2005 re +f* +1 g +374.479 421.898 4.0144 0.2005 re +f* +0.498 0 0.482 rg +378.494 421.898 9.6345 0.2005 re +f* +1 g +388.128 421.898 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 421.898 6.8244 0.2005 re +f* +1 g +398.566 421.898 16.4591 0.2005 re +f* +0.498 0 0.482 rg +415.025 421.898 2.6093 0.2005 re +f* +0 g +250.234 422.099 21.0756 0.2006 re +f* +1 g +271.31 422.099 7.6273 0.2006 re +f* +0 g +278.937 422.099 16.0575 0.2006 re +f* +1 g +294.994 422.099 3.613 0.2006 re +f* +0 g +298.607 422.099 11.441 0.2006 re +f* +1 g +310.048 422.099 4.6166 0.2006 re +f* +0 g +314.665 422.099 16.0575 0.2006 re +f* +1 g +330.722 422.099 4.2151 0.2006 re +f* +0 g +334.938 422.099 17.6633 0.2006 re +f* +1 g +352.601 422.099 6.6237 0.2006 re +f* +0.498 0 0.482 rg +359.225 422.099 4.4159 0.2006 re +f* +1 g +363.641 422.099 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 422.099 7.2259 0.2006 re +f* +1 g +374.479 422.099 4.0144 0.2006 re +f* +0.498 0 0.482 rg +378.494 422.099 9.6345 0.2006 re +f* +1 g +388.128 422.099 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 422.099 7.0252 0.2006 re +f* +1 g +398.766 422.099 16.2583 0.2006 re +f* +0.498 0 0.482 rg +415.025 422.099 2.6093 0.2006 re +f* +0 g +250.234 422.299 21.0756 0.2005 re +f* +1 g +271.31 422.299 7.6273 0.2005 re +f* +0 g +278.937 422.299 16.0575 0.2005 re +f* +1 g +294.994 422.299 3.613 0.2005 re +f* +0 g +298.607 422.299 11.441 0.2005 re +f* +1 g +310.048 422.299 4.6166 0.2005 re +f* +0 g +314.665 422.299 16.0575 0.2005 re +f* +1 g +330.722 422.299 4.2151 0.2005 re +f* +0 g +334.938 422.299 17.6633 0.2005 re +f* +1 g +352.601 422.299 6.8245 0.2005 re +f* +0.498 0 0.482 rg +359.425 422.299 4.2151 0.2005 re +f* +1 g +363.641 422.299 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 422.299 7.2259 0.2005 re +f* +1 g +374.479 422.299 4.0144 0.2005 re +f* +0.498 0 0.482 rg +378.494 422.299 9.6345 0.2005 re +f* +1 g +388.128 422.299 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 422.299 7.0252 0.2005 re +f* +1 g +398.766 422.299 16.2583 0.2005 re +f* +0.498 0 0.482 rg +415.025 422.299 2.4086 0.2005 re +f* +0 g +250.234 422.5 21.0756 0.2006 re +f* +1 g +271.31 422.5 7.6273 0.2006 re +f* +0 g +278.937 422.5 16.0575 0.2006 re +f* +1 g +294.994 422.5 3.613 0.2006 re +f* +0 g +298.607 422.5 11.441 0.2006 re +f* +1 g +310.048 422.5 4.6166 0.2006 re +f* +0 g +314.665 422.5 16.0575 0.2006 re +f* +1 g +330.722 422.5 4.2151 0.2006 re +f* +0 g +334.938 422.5 17.6633 0.2006 re +f* +1 g +352.601 422.5 6.8245 0.2006 re +f* +0.498 0 0.482 rg +359.425 422.5 4.2151 0.2006 re +f* +1 g +363.641 422.5 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 422.5 7.2259 0.2006 re +f* +1 g +374.479 422.5 4.0144 0.2006 re +f* +0.498 0 0.482 rg +378.494 422.5 9.6345 0.2006 re +f* +1 g +388.128 422.5 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 422.5 7.0252 0.2006 re +f* +1 g +398.766 422.5 4.0144 0.2006 re +f* +0.498 0 0.482 rg +402.781 422.5 8.0287 0.2006 re +f* +1 g +410.81 422.5 4.2152 0.2006 re +f* +0.498 0 0.482 rg +415.025 422.5 2.4086 0.2006 re +f* +0 g +250.234 422.7 21.0756 0.2006 re +f* +1 g +271.31 422.7 7.6273 0.2006 re +f* +0 g +278.937 422.7 16.0575 0.2006 re +f* +1 g +294.994 422.7 3.613 0.2006 re +f* +0 g +298.607 422.7 11.6417 0.2006 re +f* +1 g +310.249 422.7 4.4159 0.2006 re +f* +0 g +314.665 422.7 16.0575 0.2006 re +f* +1 g +330.722 422.7 4.2151 0.2006 re +f* +0 g +334.938 422.7 17.6633 0.2006 re +f* +1 g +352.601 422.7 6.8245 0.2006 re +f* +0.498 0 0.482 rg +359.425 422.7 4.2151 0.2006 re +f* +1 g +363.641 422.7 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 422.7 7.2259 0.2006 re +f* +1 g +374.479 422.7 4.0144 0.2006 re +f* +0.498 0 0.482 rg +378.494 422.7 9.6345 0.2006 re +f* +1 g +388.128 422.7 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 422.7 7.0252 0.2006 re +f* +1 g +398.766 422.7 4.0144 0.2006 re +f* +0.498 0 0.482 rg +402.781 422.7 8.0287 0.2006 re +f* +1 g +410.81 422.7 4.2152 0.2006 re +f* +0.498 0 0.482 rg +415.025 422.7 2.4086 0.2006 re +f* +0 g +250.435 422.901 20.8749 0.2005 re +f* +1 g +271.31 422.901 7.6273 0.2005 re +f* +0 g +278.937 422.901 16.0575 0.2005 re +f* +1 g +294.994 422.901 3.613 0.2005 re +f* +0 g +298.607 422.901 11.6417 0.2005 re +f* +1 g +310.249 422.901 16.6597 0.2005 re +f* +0 g +326.909 422.901 4.0144 0.2005 re +f* +1 g +330.923 422.901 4.0144 0.2005 re +f* +0 g +334.938 422.901 12.0431 0.2005 re +f* +1 g +346.981 422.901 0.2008 0.2005 re +f* +0 g +347.181 422.901 5.4194 0.2005 re +f* +1 g +352.601 422.901 6.8245 0.2005 re +f* +0.498 0 0.482 rg +359.425 422.901 4.2151 0.2005 re +f* +1 g +363.641 422.901 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 422.901 7.4267 0.2005 re +f* +1 g +374.68 422.901 3.8136 0.2005 re +f* +0.498 0 0.482 rg +378.494 422.901 9.6345 0.2005 re +f* +1 g +388.128 422.901 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 422.901 7.2259 0.2005 re +f* +1 g +398.967 422.901 3.8137 0.2005 re +f* +0.498 0 0.482 rg +402.781 422.901 8.0287 0.2005 re +f* +1 g +410.81 422.901 4.2152 0.2005 re +f* +0.498 0 0.482 rg +415.025 422.901 2.4086 0.2005 re +f* +0 g +250.435 423.101 20.8749 0.2006 re +f* +1 g +271.31 423.101 7.6273 0.2006 re +f* +0 g +278.937 423.101 16.0575 0.2006 re +f* +1 g +294.994 423.101 3.613 0.2006 re +f* +0 g +298.607 423.101 11.6417 0.2006 re +f* +1 g +310.249 423.101 16.6597 0.2006 re +f* +0 g +326.909 423.101 4.0144 0.2006 re +f* +1 g +330.923 423.101 16.2583 0.2006 re +f* +0 g +347.181 423.101 5.4194 0.2006 re +f* +1 g +352.601 423.101 6.8245 0.2006 re +f* +0.498 0 0.482 rg +359.425 423.101 4.2151 0.2006 re +f* +1 g +363.641 423.101 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 423.101 7.4267 0.2006 re +f* +1 g +374.68 423.101 3.8136 0.2006 re +f* +0.498 0 0.482 rg +378.494 423.101 9.6345 0.2006 re +f* +1 g +388.128 423.101 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 423.101 7.2259 0.2006 re +f* +1 g +398.967 423.101 3.8137 0.2006 re +f* +0.498 0 0.482 rg +402.781 423.101 8.0287 0.2006 re +f* +1 g +410.81 423.101 4.0144 0.2006 re +f* +0.498 0 0.482 rg +414.824 423.101 2.6094 0.2006 re +f* +0 g +250.435 423.302 20.8749 0.2005 re +f* +1 g +271.31 423.302 7.6273 0.2005 re +f* +0 g +278.937 423.302 16.0575 0.2005 re +f* +1 g +294.994 423.302 3.613 0.2005 re +f* +0 g +298.607 423.302 11.8425 0.2005 re +f* +1 g +310.45 423.302 4.2151 0.2005 re +f* +0 g +314.665 423.302 8.4302 0.2005 re +f* +1 g +323.095 423.302 3.8136 0.2005 re +f* +0 g +326.909 423.302 4.0144 0.2005 re +f* +1 g +330.923 423.302 16.2583 0.2005 re +f* +0 g +347.181 423.302 5.4194 0.2005 re +f* +1 g +352.601 423.302 6.8245 0.2005 re +f* +0.498 0 0.482 rg +359.425 423.302 4.2151 0.2005 re +f* +1 g +363.641 423.302 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 423.302 7.4267 0.2005 re +f* +1 g +374.68 423.302 3.8136 0.2005 re +f* +0.498 0 0.482 rg +378.494 423.302 9.6345 0.2005 re +f* +1 g +388.128 423.302 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 423.302 7.2259 0.2005 re +f* +1 g +398.967 423.302 3.8137 0.2005 re +f* +0.498 0 0.482 rg +402.781 423.302 8.0287 0.2005 re +f* +1 g +410.81 423.302 4.0144 0.2005 re +f* +0.498 0 0.482 rg +414.824 423.302 2.6094 0.2005 re +f* +0 g +250.435 423.502 20.8749 0.2006 re +f* +1 g +271.31 423.502 7.6273 0.2006 re +f* +0 g +278.937 423.502 16.0575 0.2006 re +f* +1 g +294.994 423.502 3.613 0.2006 re +f* +0 g +298.607 423.502 11.8425 0.2006 re +f* +1 g +310.45 423.502 4.4157 0.2006 re +f* +0 g +314.866 423.502 8.2296 0.2006 re +f* +1 g +323.095 423.502 3.8136 0.2006 re +f* +0 g +326.909 423.502 4.0144 0.2006 re +f* +1 g +330.923 423.502 16.2583 0.2006 re +f* +0 g +347.181 423.502 5.2187 0.2006 re +f* +1 g +352.4 423.502 7.0252 0.2006 re +f* +0.498 0 0.482 rg +359.425 423.502 4.2151 0.2006 re +f* +1 g +363.641 423.502 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 423.502 7.4267 0.2006 re +f* +1 g +374.68 423.502 3.8136 0.2006 re +f* +0.498 0 0.482 rg +378.494 423.502 9.6345 0.2006 re +f* +1 g +388.128 423.502 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 423.502 7.4266 0.2006 re +f* +1 g +399.168 423.502 3.613 0.2006 re +f* +0.498 0 0.482 rg +402.781 423.502 8.0287 0.2006 re +f* +1 g +410.81 423.502 4.0144 0.2006 re +f* +0.498 0 0.482 rg +414.824 423.502 2.6094 0.2006 re +f* +0 g +250.435 423.703 20.8749 0.2006 re +f* +1 g +271.31 423.703 7.6273 0.2006 re +f* +0 g +278.937 423.703 16.0575 0.2006 re +f* +1 g +294.994 423.703 3.613 0.2006 re +f* +0 g +298.607 423.703 12.0432 0.2006 re +f* +1 g +310.651 423.703 4.215 0.2006 re +f* +0 g +314.866 423.703 8.2296 0.2006 re +f* +1 g +323.095 423.703 3.8136 0.2006 re +f* +0 g +326.909 423.703 4.0144 0.2006 re +f* +1 g +330.923 423.703 4.0144 0.2006 re +f* +0 g +334.938 423.703 8.0288 0.2006 re +f* +1 g +342.966 423.703 4.2151 0.2006 re +f* +0 g +347.181 423.703 5.2187 0.2006 re +f* +1 g +352.4 423.703 7.2259 0.2006 re +f* +0.498 0 0.482 rg +359.626 423.703 4.0144 0.2006 re +f* +1 g +363.641 423.703 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 423.703 7.6274 0.2006 re +f* +1 g +374.881 423.703 3.8137 0.2006 re +f* +0.498 0 0.482 rg +378.695 423.703 9.2331 0.2006 re +f* +1 g +387.928 423.703 3.8136 0.2006 re +f* +0.498 0 0.482 rg +391.741 423.703 7.4266 0.2006 re +f* +1 g +399.168 423.703 3.8137 0.2006 re +f* +0.498 0 0.482 rg +402.981 423.703 7.828 0.2006 re +f* +1 g +410.81 423.703 4.0144 0.2006 re +f* +0.498 0 0.482 rg +414.824 423.703 2.6094 0.2006 re +f* +0 g +250.435 423.904 20.8749 0.2005 re +f* +1 g +271.31 423.904 7.6273 0.2005 re +f* +0 g +278.937 423.904 16.0575 0.2005 re +f* +1 g +294.994 423.904 3.8137 0.2005 re +f* +0 g +298.808 423.904 11.8425 0.2005 re +f* +1 g +310.651 423.904 4.215 0.2005 re +f* +0 g +314.866 423.904 8.2296 0.2005 re +f* +1 g +323.095 423.904 3.8136 0.2005 re +f* +0 g +326.909 423.904 4.2151 0.2005 re +f* +1 g +331.124 423.904 3.8137 0.2005 re +f* +0 g +334.938 423.904 8.0288 0.2005 re +f* +1 g +342.966 423.904 4.2151 0.2005 re +f* +0 g +347.181 423.904 5.2187 0.2005 re +f* +1 g +352.4 423.904 7.2259 0.2005 re +f* +0.498 0 0.482 rg +359.626 423.904 4.0144 0.2005 re +f* +1 g +363.641 423.904 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 423.904 7.6274 0.2005 re +f* +1 g +374.881 423.904 3.8137 0.2005 re +f* +0.498 0 0.482 rg +378.695 423.904 9.2331 0.2005 re +f* +1 g +387.928 423.904 3.8136 0.2005 re +f* +0.498 0 0.482 rg +391.741 423.904 7.4266 0.2005 re +f* +1 g +399.168 423.904 3.8137 0.2005 re +f* +0.498 0 0.482 rg +402.981 423.904 7.828 0.2005 re +f* +1 g +410.81 423.904 4.0144 0.2005 re +f* +0.498 0 0.482 rg +414.824 423.904 2.6094 0.2005 re +f* +0 g +250.435 424.104 20.8749 0.2006 re +f* +1 g +271.31 424.104 7.6273 0.2006 re +f* +0 g +278.937 424.104 16.0575 0.2006 re +f* +1 g +294.994 424.104 3.8137 0.2006 re +f* +0 g +298.808 424.104 11.8425 0.2006 re +f* +1 g +310.651 424.104 4.215 0.2006 re +f* +0 g +314.866 424.104 8.4303 0.2006 re +f* +1 g +323.296 424.104 3.6129 0.2006 re +f* +0 g +326.909 424.104 4.2151 0.2006 re +f* +1 g +331.124 424.104 3.8137 0.2006 re +f* +0 g +334.938 424.104 8.0288 0.2006 re +f* +1 g +342.966 424.104 4.2151 0.2006 re +f* +0 g +347.181 424.104 5.2187 0.2006 re +f* +1 g +352.4 424.104 7.2259 0.2006 re +f* +0.498 0 0.482 rg +359.626 424.104 4.0144 0.2006 re +f* +1 g +363.641 424.104 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 424.104 7.8281 0.2006 re +f* +1 g +375.081 424.104 3.613 0.2006 re +f* +0.498 0 0.482 rg +378.695 424.104 9.2331 0.2006 re +f* +1 g +387.928 424.104 3.8136 0.2006 re +f* +0.498 0 0.482 rg +391.741 424.104 7.6273 0.2006 re +f* +1 g +399.368 424.104 3.613 0.2006 re +f* +0.498 0 0.482 rg +402.981 424.104 7.828 0.2006 re +f* +1 g +410.81 424.104 3.8137 0.2006 re +f* +0.498 0 0.482 rg +414.623 424.104 2.8101 0.2006 re +f* +0 g +250.435 424.305 20.8749 0.2005 re +f* +1 g +271.31 424.305 7.6273 0.2005 re +f* +0 g +278.937 424.305 16.0575 0.2005 re +f* +1 g +294.994 424.305 3.8137 0.2005 re +f* +0 g +298.808 424.305 12.0432 0.2005 re +f* +1 g +310.851 424.305 4.0143 0.2005 re +f* +0 g +314.866 424.305 8.4303 0.2005 re +f* +1 g +323.296 424.305 3.6129 0.2005 re +f* +0 g +326.909 424.305 4.2151 0.2005 re +f* +1 g +331.124 424.305 4.0144 0.2005 re +f* +0 g +335.138 424.305 7.8281 0.2005 re +f* +1 g +342.966 424.305 4.2151 0.2005 re +f* +0 g +347.181 424.305 5.2187 0.2005 re +f* +1 g +352.4 424.305 7.2259 0.2005 re +f* +0.498 0 0.482 rg +359.626 424.305 4.0144 0.2005 re +f* +1 g +363.641 424.305 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 424.305 7.8281 0.2005 re +f* +1 g +375.081 424.305 3.613 0.2005 re +f* +0.498 0 0.482 rg +378.695 424.305 9.2331 0.2005 re +f* +1 g +387.928 424.305 3.8136 0.2005 re +f* +0.498 0 0.482 rg +391.741 424.305 7.6273 0.2005 re +f* +1 g +399.368 424.305 3.613 0.2005 re +f* +0.498 0 0.482 rg +402.981 424.305 7.828 0.2005 re +f* +1 g +410.81 424.305 3.8137 0.2005 re +f* +0.498 0 0.482 rg +414.623 424.305 2.6093 0.2005 re +f* +0 g +250.435 424.505 20.8749 0.2006 re +f* +1 g +271.31 424.505 7.6273 0.2006 re +f* +0 g +278.937 424.505 16.0575 0.2006 re +f* +1 g +294.994 424.505 3.8137 0.2006 re +f* +0 g +298.808 424.505 12.0432 0.2006 re +f* +1 g +310.851 424.505 4.0143 0.2006 re +f* +0 g +314.866 424.505 8.4303 0.2006 re +f* +1 g +323.296 424.505 3.6129 0.2006 re +f* +0 g +326.909 424.505 4.4158 0.2006 re +f* +1 g +331.325 424.505 3.8137 0.2006 re +f* +0 g +335.138 424.505 7.8281 0.2006 re +f* +1 g +342.966 424.505 4.0143 0.2006 re +f* +0 g +346.981 424.505 5.2188 0.2006 re +f* +1 g +352.2 424.505 7.4266 0.2006 re +f* +0.498 0 0.482 rg +359.626 424.505 4.0144 0.2006 re +f* +1 g +363.641 424.505 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 424.505 8.0288 0.2006 re +f* +1 g +375.282 424.505 3.4123 0.2006 re +f* +0.498 0 0.482 rg +378.695 424.505 9.2331 0.2006 re +f* +1 g +387.928 424.505 3.8136 0.2006 re +f* +0.498 0 0.482 rg +391.741 424.505 7.828 0.2006 re +f* +1 g +399.569 424.505 3.4123 0.2006 re +f* +0.498 0 0.482 rg +402.981 424.505 7.828 0.2006 re +f* +1 g +410.81 424.505 3.8137 0.2006 re +f* +0.498 0 0.482 rg +414.623 424.505 2.6093 0.2006 re +f* +0 g +250.635 424.706 20.6741 0.2006 re +f* +1 g +271.31 424.706 7.6273 0.2006 re +f* +0 g +278.937 424.706 16.0575 0.2006 re +f* +1 g +294.994 424.706 3.8137 0.2006 re +f* +0 g +298.808 424.706 12.2439 0.2006 re +f* +1 g +311.052 424.706 3.8136 0.2006 re +f* +0 g +314.866 424.706 8.4303 0.2006 re +f* +1 g +323.296 424.706 3.4122 0.2006 re +f* +0 g +326.708 424.706 4.6165 0.2006 re +f* +1 g +331.325 424.706 3.8137 0.2006 re +f* +0 g +335.138 424.706 7.8281 0.2006 re +f* +1 g +342.966 424.706 4.0143 0.2006 re +f* +0 g +346.981 424.706 5.2188 0.2006 re +f* +1 g +352.2 424.706 7.4266 0.2006 re +f* +0.498 0 0.482 rg +359.626 424.706 4.0144 0.2006 re +f* +1 g +363.641 424.706 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 424.706 8.0288 0.2006 re +f* +1 g +375.282 424.706 3.4123 0.2006 re +f* +0.498 0 0.482 rg +378.695 424.706 9.2331 0.2006 re +f* +1 g +387.928 424.706 3.8136 0.2006 re +f* +0.498 0 0.482 rg +391.741 424.706 7.828 0.2006 re +f* +1 g +399.569 424.706 3.4123 0.2006 re +f* +0.498 0 0.482 rg +402.981 424.706 7.828 0.2006 re +f* +1 g +410.81 424.706 3.8137 0.2006 re +f* +0.498 0 0.482 rg +414.623 424.706 2.6093 0.2006 re +f* +0 g +250.635 424.906 20.6741 0.2005 re +f* +1 g +271.31 424.906 7.6273 0.2005 re +f* +0 g +278.937 424.906 16.0575 0.2005 re +f* +1 g +294.994 424.906 3.8137 0.2005 re +f* +0 g +298.808 424.906 12.2439 0.2005 re +f* +1 g +311.052 424.906 3.8136 0.2005 re +f* +0 g +314.866 424.906 8.4303 0.2005 re +f* +1 g +323.296 424.906 3.4122 0.2005 re +f* +0 g +326.708 424.906 4.6165 0.2005 re +f* +1 g +331.325 424.906 3.8137 0.2005 re +f* +0 g +335.138 424.906 7.8281 0.2005 re +f* +1 g +342.966 424.906 4.0143 0.2005 re +f* +0 g +346.981 424.906 5.2188 0.2005 re +f* +1 g +352.2 424.906 7.4266 0.2005 re +f* +0.498 0 0.482 rg +359.626 424.906 4.0144 0.2005 re +f* +1 g +363.641 424.906 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 424.906 8.2295 0.2005 re +f* +1 g +375.483 424.906 3.2116 0.2005 re +f* +0.498 0 0.482 rg +378.695 424.906 9.0323 0.2005 re +f* +1 g +387.727 424.906 4.0144 0.2005 re +f* +0.498 0 0.482 rg +391.741 424.906 8.0288 0.2005 re +f* +1 g +399.77 424.906 3.4122 0.2005 re +f* +0.498 0 0.482 rg +403.182 424.906 7.6273 0.2005 re +f* +1 g +410.81 424.906 3.613 0.2005 re +f* +0.498 0 0.482 rg +414.422 424.906 2.81 0.2005 re +f* +0 g +250.635 425.107 20.8748 0.2006 re +f* +1 g +271.51 425.107 7.4266 0.2006 re +f* +0 g +278.937 425.107 16.0575 0.2006 re +f* +1 g +294.994 425.107 4.0144 0.2006 re +f* +0 g +299.009 425.107 5.2187 0.2006 re +f* +1 g +304.227 425.107 2.208 0.2006 re +f* +0 g +306.435 425.107 4.8172 0.2006 re +f* +1 g +311.253 425.107 3.6129 0.2006 re +f* +0 g +314.866 425.107 8.4303 0.2006 re +f* +1 g +323.296 425.107 3.4122 0.2006 re +f* +0 g +326.708 425.107 4.8173 0.2006 re +f* +1 g +331.525 425.107 3.6129 0.2006 re +f* +0 g +335.138 425.107 7.8281 0.2006 re +f* +1 g +342.966 425.107 4.0143 0.2006 re +f* +0 g +346.981 425.107 5.018 0.2006 re +f* +1 g +351.999 425.107 7.6274 0.2006 re +f* +0.498 0 0.482 rg +359.626 425.107 4.0144 0.2006 re +f* +1 g +363.641 425.107 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 425.107 8.2295 0.2006 re +f* +1 g +375.483 425.107 3.4123 0.2006 re +f* +0.498 0 0.482 rg +378.895 425.107 8.8316 0.2006 re +f* +1 g +387.727 425.107 4.0144 0.2006 re +f* +0.498 0 0.482 rg +391.741 425.107 8.2295 0.2006 re +f* +1 g +399.971 425.107 3.2115 0.2006 re +f* +0.498 0 0.482 rg +403.182 425.107 7.6273 0.2006 re +f* +1 g +410.81 425.107 3.613 0.2006 re +f* +0.498 0 0.482 rg +414.422 425.107 2.81 0.2006 re +f* +0 g +250.635 425.308 20.8748 0.2005 re +f* +1 g +271.51 425.308 7.4266 0.2005 re +f* +0 g +278.937 425.308 16.0575 0.2005 re +f* +1 g +294.994 425.308 4.0144 0.2005 re +f* +0 g +299.009 425.308 4.8173 0.2005 re +f* +1 g +303.826 425.308 3.0108 0.2005 re +f* +0 g +306.837 425.308 4.4158 0.2005 re +f* +1 g +311.253 425.308 3.8137 0.2005 re +f* +0 g +315.066 425.308 8.2295 0.2005 re +f* +1 g +323.296 425.308 3.4122 0.2005 re +f* +0 g +326.708 425.308 4.8173 0.2005 re +f* +1 g +331.525 425.308 3.6129 0.2005 re +f* +0 g +335.138 425.308 7.8281 0.2005 re +f* +1 g +342.966 425.308 4.0143 0.2005 re +f* +0 g +346.981 425.308 5.018 0.2005 re +f* +1 g +351.999 425.308 7.6274 0.2005 re +f* +0.498 0 0.482 rg +359.626 425.308 4.0144 0.2005 re +f* +1 g +363.641 425.308 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 425.308 8.4303 0.2005 re +f* +1 g +375.684 425.308 3.2115 0.2005 re +f* +0.498 0 0.482 rg +378.895 425.308 8.8316 0.2005 re +f* +1 g +387.727 425.308 4.0144 0.2005 re +f* +0.498 0 0.482 rg +391.741 425.308 8.2295 0.2005 re +f* +1 g +399.971 425.308 3.2115 0.2005 re +f* +0.498 0 0.482 rg +403.182 425.308 7.6273 0.2005 re +f* +1 g +410.81 425.308 3.4122 0.2005 re +f* +0.498 0 0.482 rg +414.222 425.308 3.0108 0.2005 re +f* +0 g +250.635 425.508 20.8748 0.2006 re +f* +1 g +271.51 425.508 7.4266 0.2006 re +f* +0 g +278.937 425.508 16.0575 0.2006 re +f* +1 g +294.994 425.508 4.0144 0.2006 re +f* +0 g +299.009 425.508 4.6166 0.2006 re +f* +1 g +303.625 425.508 3.4122 0.2006 re +f* +0 g +307.038 425.508 4.4158 0.2006 re +f* +1 g +311.453 425.508 3.613 0.2006 re +f* +0 g +315.066 425.508 8.2295 0.2006 re +f* +1 g +323.296 425.508 3.2115 0.2006 re +f* +0 g +326.507 425.508 5.2187 0.2006 re +f* +1 g +331.726 425.508 3.4122 0.2006 re +f* +0 g +335.138 425.508 7.8281 0.2006 re +f* +1 g +342.966 425.508 3.8137 0.2006 re +f* +0 g +346.78 425.508 5.2186 0.2006 re +f* +1 g +351.999 425.508 7.6274 0.2006 re +f* +0.498 0 0.482 rg +359.626 425.508 4.0144 0.2006 re +f* +1 g +363.641 425.508 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 425.508 8.4303 0.2006 re +f* +1 g +375.684 425.508 3.2115 0.2006 re +f* +0.498 0 0.482 rg +378.895 425.508 8.6309 0.2006 re +f* +1 g +387.526 425.508 4.2151 0.2006 re +f* +0.498 0 0.482 rg +391.741 425.508 8.4302 0.2006 re +f* +1 g +400.171 425.508 3.2115 0.2006 re +f* +0.498 0 0.482 rg +403.383 425.508 7.4266 0.2006 re +f* +1 g +410.81 425.508 3.4122 0.2006 re +f* +0.498 0 0.482 rg +414.222 425.508 2.8102 0.2006 re +f* +0 g +250.635 425.709 20.8748 0.2005 re +f* +1 g +271.51 425.709 7.4266 0.2005 re +f* +0 g +278.937 425.709 16.0575 0.2005 re +f* +1 g +294.994 425.709 4.2151 0.2005 re +f* +0 g +299.209 425.709 4.4159 0.2005 re +f* +1 g +303.625 425.709 3.6129 0.2005 re +f* +0 g +307.238 425.709 4.4159 0.2005 re +f* +1 g +311.654 425.709 3.4122 0.2005 re +f* +0 g +315.066 425.709 8.0288 0.2005 re +f* +1 g +323.095 425.709 3.4122 0.2005 re +f* +0 g +326.507 425.709 5.2187 0.2005 re +f* +1 g +331.726 425.709 3.613 0.2005 re +f* +0 g +335.339 425.709 7.6273 0.2005 re +f* +1 g +342.966 425.709 3.8137 0.2005 re +f* +0 g +346.78 425.709 5.018 0.2005 re +f* +1 g +351.798 425.709 7.828 0.2005 re +f* +0.498 0 0.482 rg +359.626 425.709 4.0144 0.2005 re +f* +1 g +363.641 425.709 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 425.709 8.631 0.2005 re +f* +1 g +375.884 425.709 3.0108 0.2005 re +f* +0.498 0 0.482 rg +378.895 425.709 8.6309 0.2005 re +f* +1 g +387.526 425.709 4.2151 0.2005 re +f* +0.498 0 0.482 rg +391.741 425.709 8.6309 0.2005 re +f* +1 g +400.372 425.709 3.0108 0.2005 re +f* +0.498 0 0.482 rg +403.383 425.709 7.4266 0.2005 re +f* +1 g +410.81 425.709 3.4122 0.2005 re +f* +0.498 0 0.482 rg +414.222 425.709 2.8102 0.2005 re +f* +0 g +250.836 425.909 20.6741 0.2006 re +f* +1 g +271.51 425.909 7.4266 0.2006 re +f* +0 g +278.937 425.909 16.0575 0.2006 re +f* +1 g +294.994 425.909 4.2151 0.2006 re +f* +0 g +299.209 425.909 4.4159 0.2006 re +f* +1 g +303.625 425.909 3.6129 0.2006 re +f* +0 g +307.238 425.909 4.4159 0.2006 re +f* +1 g +311.654 425.909 3.4122 0.2006 re +f* +0 g +315.066 425.909 8.0288 0.2006 re +f* +1 g +323.095 425.909 3.2115 0.2006 re +f* +0 g +326.307 425.909 5.6201 0.2006 re +f* +1 g +331.927 425.909 3.4123 0.2006 re +f* +0 g +335.339 425.909 7.6273 0.2006 re +f* +1 g +342.966 425.909 3.8137 0.2006 re +f* +0 g +346.78 425.909 5.018 0.2006 re +f* +1 g +351.798 425.909 7.828 0.2006 re +f* +0.498 0 0.482 rg +359.626 425.909 4.0144 0.2006 re +f* +1 g +363.641 425.909 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 425.909 8.8317 0.2006 re +f* +1 g +376.085 425.909 3.0108 0.2006 re +f* +0.498 0 0.482 rg +379.096 425.909 8.4302 0.2006 re +f* +1 g +387.526 425.909 4.2151 0.2006 re +f* +0.498 0 0.482 rg +391.741 425.909 8.6309 0.2006 re +f* +1 g +400.372 425.909 3.0108 0.2006 re +f* +0.498 0 0.482 rg +403.383 425.909 7.2259 0.2006 re +f* +1 g +410.609 425.909 3.4123 0.2006 re +f* +0.498 0 0.482 rg +414.021 425.909 3.0108 0.2006 re +f* +0 g +250.836 426.11 20.6741 0.2006 re +f* +1 g +271.51 426.11 7.4266 0.2006 re +f* +0 g +278.937 426.11 16.0575 0.2006 re +f* +1 g +294.994 426.11 4.2151 0.2006 re +f* +0 g +299.209 426.11 4.4159 0.2006 re +f* +1 g +303.625 426.11 3.6129 0.2006 re +f* +0 g +307.238 426.11 4.6166 0.2006 re +f* +1 g +311.855 426.11 3.2115 0.2006 re +f* +0 g +315.066 426.11 8.0288 0.2006 re +f* +1 g +323.095 426.11 3.2115 0.2006 re +f* +0 g +326.307 426.11 5.6201 0.2006 re +f* +1 g +331.927 426.11 3.4123 0.2006 re +f* +0 g +335.339 426.11 7.6273 0.2006 re +f* +1 g +342.966 426.11 3.6129 0.2006 re +f* +0 g +346.579 426.11 5.2188 0.2006 re +f* +1 g +351.798 426.11 8.0287 0.2006 re +f* +0.498 0 0.482 rg +359.827 426.11 3.8137 0.2006 re +f* +1 g +363.641 426.11 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 426.11 8.8317 0.2006 re +f* +1 g +376.085 426.11 3.0108 0.2006 re +f* +0.498 0 0.482 rg +379.096 426.11 8.2294 0.2006 re +f* +1 g +387.325 426.11 4.4159 0.2006 re +f* +0.498 0 0.482 rg +391.741 426.11 8.8316 0.2006 re +f* +1 g +400.573 426.11 3.0108 0.2006 re +f* +0.498 0 0.482 rg +403.584 426.11 7.0252 0.2006 re +f* +1 g +410.609 426.11 3.2115 0.2006 re +f* +0.498 0 0.482 rg +413.82 426.11 3.2116 0.2006 re +f* +0 g +250.836 426.31 20.6741 0.2005 re +f* +1 g +271.51 426.31 7.4266 0.2005 re +f* +0 g +278.937 426.31 16.0575 0.2005 re +f* +1 g +294.994 426.31 4.4159 0.2005 re +f* +0 g +299.41 426.31 4.2151 0.2005 re +f* +1 g +303.625 426.31 3.8137 0.2005 re +f* +0 g +307.439 426.31 4.4158 0.2005 re +f* +1 g +311.855 426.31 3.4122 0.2005 re +f* +0 g +315.267 426.31 7.8281 0.2005 re +f* +1 g +323.095 426.31 3.2115 0.2005 re +f* +0 g +326.307 426.31 5.8208 0.2005 re +f* +1 g +332.127 426.31 3.2116 0.2005 re +f* +0 g +335.339 426.31 7.6273 0.2005 re +f* +1 g +342.966 426.31 3.6129 0.2005 re +f* +0 g +346.579 426.31 5.018 0.2005 re +f* +1 g +351.597 426.31 8.2295 0.2005 re +f* +0.498 0 0.482 rg +359.827 426.31 3.8137 0.2005 re +f* +1 g +363.641 426.31 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 426.31 9.0324 0.2005 re +f* +1 g +376.286 426.31 3.0108 0.2005 re +f* +0.498 0 0.482 rg +379.297 426.31 8.0287 0.2005 re +f* +1 g +387.325 426.31 4.4159 0.2005 re +f* +0.498 0 0.482 rg +391.741 426.31 9.0324 0.2005 re +f* +1 g +400.774 426.31 2.81 0.2005 re +f* +0.498 0 0.482 rg +403.584 426.31 7.0252 0.2005 re +f* +1 g +410.609 426.31 3.2115 0.2005 re +f* +0.498 0 0.482 rg +413.82 426.31 3.2116 0.2005 re +f* +0 g +250.836 426.511 20.6741 0.2006 re +f* +1 g +271.51 426.511 7.4266 0.2006 re +f* +0 g +278.937 426.511 16.0575 0.2006 re +f* +1 g +294.994 426.511 4.4159 0.2006 re +f* +0 g +299.41 426.511 4.2151 0.2006 re +f* +1 g +303.625 426.511 3.8137 0.2006 re +f* +0 g +307.439 426.511 4.6165 0.2006 re +f* +1 g +312.056 426.511 3.2115 0.2006 re +f* +0 g +315.267 426.511 7.8281 0.2006 re +f* +1 g +323.095 426.511 3.0107 0.2006 re +f* +0 g +326.106 426.511 6.2223 0.2006 re +f* +1 g +332.328 426.511 3.2116 0.2006 re +f* +0 g +335.54 426.511 7.4266 0.2006 re +f* +1 g +342.966 426.511 3.4122 0.2006 re +f* +0 g +346.379 426.511 5.2187 0.2006 re +f* +1 g +351.597 426.511 8.2295 0.2006 re +f* +0.498 0 0.482 rg +359.827 426.511 3.8137 0.2006 re +f* +1 g +363.641 426.511 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 426.511 9.2331 0.2006 re +f* +1 g +376.486 426.511 2.8101 0.2006 re +f* +0.498 0 0.482 rg +379.297 426.511 7.828 0.2006 re +f* +1 g +387.125 426.511 4.6166 0.2006 re +f* +0.498 0 0.482 rg +391.741 426.511 9.2331 0.2006 re +f* +1 g +400.974 426.511 2.8101 0.2006 re +f* +0.498 0 0.482 rg +403.784 426.511 6.8244 0.2006 re +f* +1 g +410.609 426.511 3.0108 0.2006 re +f* +0.498 0 0.482 rg +413.62 426.511 3.4123 0.2006 re +f* +0 g +250.836 426.711 20.6741 0.2005 re +f* +1 g +271.51 426.711 7.4266 0.2005 re +f* +0 g +278.937 426.711 16.0575 0.2005 re +f* +1 g +294.994 426.711 4.6166 0.2005 re +f* +0 g +299.611 426.711 4.0144 0.2005 re +f* +1 g +303.625 426.711 3.8137 0.2005 re +f* +0 g +307.439 426.711 4.8172 0.2005 re +f* +1 g +312.256 426.711 3.0108 0.2005 re +f* +0 g +315.267 426.711 7.8281 0.2005 re +f* +1 g +323.095 426.711 3.0107 0.2005 re +f* +0 g +326.106 426.711 6.2223 0.2005 re +f* +1 g +332.328 426.711 3.2116 0.2005 re +f* +0 g +335.54 426.711 7.4266 0.2005 re +f* +1 g +342.966 426.711 3.4122 0.2005 re +f* +0 g +346.379 426.711 5.018 0.2005 re +f* +1 g +351.397 426.711 8.4302 0.2005 re +f* +0.498 0 0.482 rg +359.827 426.711 3.8137 0.2005 re +f* +1 g +363.641 426.711 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 426.711 9.4339 0.2005 re +f* +1 g +376.687 426.711 2.6093 0.2005 re +f* +0.498 0 0.482 rg +379.297 426.711 7.6274 0.2005 re +f* +1 g +386.924 426.711 1.0036 0.2005 re +f* +0.498 0 0.482 rg +387.928 426.711 0.2006 0.2005 re +f* +1 g +388.128 426.711 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 426.711 9.4338 0.2005 re +f* +1 g +401.175 426.711 2.6094 0.2005 re +f* +0.498 0 0.482 rg +403.784 426.711 6.6237 0.2005 re +f* +1 g +410.408 426.711 3.0108 0.2005 re +f* +0.498 0 0.482 rg +413.419 426.711 3.4122 0.2005 re +f* +0 g +251.037 426.912 20.4734 0.2006 re +f* +1 g +271.51 426.912 7.4266 0.2006 re +f* +0 g +278.937 426.912 16.0575 0.2006 re +f* +1 g +294.994 426.912 4.6166 0.2006 re +f* +0 g +299.611 426.912 4.0144 0.2006 re +f* +1 g +303.625 426.912 3.8137 0.2006 re +f* +0 g +307.439 426.912 5.0179 0.2006 re +f* +1 g +312.457 426.912 3.0108 0.2006 re +f* +0 g +315.468 426.912 7.6274 0.2006 re +f* +1 g +323.095 426.912 2.81 0.2006 re +f* +0 g +325.905 426.912 6.6238 0.2006 re +f* +1 g +332.529 426.912 3.0108 0.2006 re +f* +0 g +335.54 426.912 7.4266 0.2006 re +f* +1 g +342.966 426.912 3.2115 0.2006 re +f* +0 g +346.178 426.912 5.2187 0.2006 re +f* +1 g +351.397 426.912 8.4302 0.2006 re +f* +0.498 0 0.482 rg +359.827 426.912 3.8137 0.2006 re +f* +1 g +363.641 426.912 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 426.912 9.6346 0.2006 re +f* +1 g +376.888 426.912 2.6093 0.2006 re +f* +0.498 0 0.482 rg +379.497 426.912 7.4267 0.2006 re +f* +1 g +386.924 426.912 1.0036 0.2006 re +f* +0.498 0 0.482 rg +387.928 426.912 0.2006 0.2006 re +f* +1 g +388.128 426.912 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 426.912 9.6345 0.2006 re +f* +1 g +401.376 426.912 2.6094 0.2006 re +f* +0.498 0 0.482 rg +403.985 426.912 6.423 0.2006 re +f* +1 g +410.408 426.912 3.0108 0.2006 re +f* +0.498 0 0.482 rg +413.419 426.912 3.4122 0.2006 re +f* +0 g +251.037 427.113 20.4734 0.2006 re +f* +1 g +271.51 427.113 7.4266 0.2006 re +f* +0 g +278.937 427.113 16.0575 0.2006 re +f* +1 g +294.994 427.113 3.613 0.2006 re +f* +0 g +298.607 427.113 0.2007 0.2006 re +f* +1 g +298.808 427.113 1.0036 0.2006 re +f* +0 g +299.812 427.113 4.0144 0.2006 re +f* +1 g +303.826 427.113 3.613 0.2006 re +f* +0 g +307.439 427.113 5.0179 0.2006 re +f* +1 g +312.457 427.113 3.0108 0.2006 re +f* +0 g +315.468 427.113 7.6274 0.2006 re +f* +1 g +323.095 427.113 2.6093 0.2006 re +f* +0 g +325.704 427.113 7.0252 0.2006 re +f* +1 g +332.73 427.113 3.0108 0.2006 re +f* +0 g +335.74 427.113 7.0252 0.2006 re +f* +1 g +342.766 427.113 3.4122 0.2006 re +f* +0 g +346.178 427.113 5.018 0.2006 re +f* +1 g +351.196 427.113 8.6309 0.2006 re +f* +0.498 0 0.482 rg +359.827 427.113 3.8137 0.2006 re +f* +1 g +363.641 427.113 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 427.113 9.8353 0.2006 re +f* +1 g +377.089 427.113 2.6094 0.2006 re +f* +0.498 0 0.482 rg +379.698 427.113 7.0251 0.2006 re +f* +1 g +386.723 427.113 1.0036 0.2006 re +f* +0.498 0 0.482 rg +387.727 427.113 0.4014 0.2006 re +f* +1 g +388.128 427.113 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 427.113 9.8352 0.2006 re +f* +1 g +401.576 427.113 2.4087 0.2006 re +f* +0.498 0 0.482 rg +403.985 427.113 6.2223 0.2006 re +f* +1 g +410.207 427.113 3.0107 0.2006 re +f* +0.498 0 0.482 rg +413.218 427.113 3.613 0.2006 re +f* +0 g +251.037 427.313 20.4734 0.2005 re +f* +1 g +271.51 427.313 7.4266 0.2005 re +f* +0 g +278.937 427.313 16.0575 0.2005 re +f* +1 g +294.994 427.313 3.613 0.2005 re +f* +0 g +298.607 427.313 0.2007 0.2005 re +f* +1 g +298.808 427.313 1.0036 0.2005 re +f* +0 g +299.812 427.313 4.0144 0.2005 re +f* +1 g +303.826 427.313 3.613 0.2005 re +f* +0 g +307.439 427.313 5.2187 0.2005 re +f* +1 g +312.658 427.313 2.81 0.2005 re +f* +0 g +315.468 427.313 7.6274 0.2005 re +f* +1 g +323.095 427.313 2.6093 0.2005 re +f* +0 g +325.704 427.313 7.2259 0.2005 re +f* +1 g +332.93 427.313 2.8101 0.2005 re +f* +0 g +335.74 427.313 7.0252 0.2005 re +f* +1 g +342.766 427.313 3.2114 0.2005 re +f* +0 g +345.977 427.313 5.2188 0.2005 re +f* +1 g +351.196 427.313 8.6309 0.2005 re +f* +0.498 0 0.482 rg +359.827 427.313 3.8137 0.2005 re +f* +1 g +363.641 427.313 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 427.313 10.036 0.2005 re +f* +1 g +377.289 427.313 2.4087 0.2005 re +f* +0.498 0 0.482 rg +379.698 427.313 6.8244 0.2005 re +f* +1 g +386.522 427.313 1.0036 0.2005 re +f* +0.498 0 0.482 rg +387.526 427.313 0.6021 0.2005 re +f* +1 g +388.128 427.313 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 427.313 10.036 0.2005 re +f* +1 g +401.777 427.313 2.4086 0.2005 re +f* +0.498 0 0.482 rg +404.186 427.313 6.0216 0.2005 re +f* +1 g +410.207 427.313 2.8101 0.2005 re +f* +0.498 0 0.482 rg +413.017 427.313 3.8136 0.2005 re +f* +0 g +251.037 427.514 20.4734 0.2006 re +f* +1 g +271.51 427.514 7.4266 0.2006 re +f* +0 g +278.937 427.514 16.0575 0.2006 re +f* +1 g +294.994 427.514 3.613 0.2006 re +f* +0 g +298.607 427.514 0.4014 0.2006 re +f* +1 g +299.009 427.514 1.0036 0.2006 re +f* +0 g +300.012 427.514 3.8137 0.2006 re +f* +1 g +303.826 427.514 3.613 0.2006 re +f* +0 g +307.439 427.514 5.4194 0.2006 re +f* +1 g +312.858 427.514 2.8101 0.2006 re +f* +0 g +315.669 427.514 7.2258 0.2006 re +f* +1 g +322.894 427.514 2.6094 0.2006 re +f* +0 g +325.504 427.514 7.4266 0.2006 re +f* +1 g +332.93 427.514 3.0108 0.2006 re +f* +0 g +335.941 427.514 6.8245 0.2006 re +f* +1 g +342.766 427.514 3.2114 0.2006 re +f* +0 g +345.977 427.514 5.018 0.2006 re +f* +1 g +350.995 427.514 8.8317 0.2006 re +f* +0.498 0 0.482 rg +359.827 427.514 3.8137 0.2006 re +f* +1 g +363.641 427.514 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 427.514 10.2367 0.2006 re +f* +1 g +377.49 427.514 2.4087 0.2006 re +f* +0.498 0 0.482 rg +379.899 427.514 6.4229 0.2006 re +f* +1 g +386.322 427.514 1.0036 0.2006 re +f* +0.498 0 0.482 rg +387.325 427.514 0.8029 0.2006 re +f* +1 g +388.128 427.514 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 427.514 10.2367 0.2006 re +f* +1 g +401.978 427.514 2.4086 0.2006 re +f* +0.498 0 0.482 rg +404.386 427.514 5.6202 0.2006 re +f* +1 g +410.007 427.514 2.81 0.2006 re +f* +0.498 0 0.482 rg +412.817 427.514 3.8137 0.2006 re +f* +0 g +251.238 427.714 20.2727 0.2005 re +f* +1 g +271.51 427.714 7.4266 0.2005 re +f* +0 g +278.937 427.714 16.0575 0.2005 re +f* +1 g +294.994 427.714 3.613 0.2005 re +f* +0 g +298.607 427.714 0.4014 0.2005 re +f* +1 g +299.009 427.714 1.0036 0.2005 re +f* +0 g +300.012 427.714 4.0144 0.2005 re +f* +1 g +304.027 427.714 3.4123 0.2005 re +f* +0 g +307.439 427.714 5.6201 0.2005 re +f* +1 g +313.059 427.714 2.6094 0.2005 re +f* +0 g +315.669 427.714 7.2258 0.2005 re +f* +1 g +322.894 427.714 2.4087 0.2005 re +f* +0 g +325.303 427.714 7.828 0.2005 re +f* +1 g +333.131 427.714 2.8101 0.2005 re +f* +0 g +335.941 427.714 6.8245 0.2005 re +f* +1 g +342.766 427.714 3.0108 0.2005 re +f* +0 g +345.776 427.714 5.018 0.2005 re +f* +1 g +350.794 427.714 9.0323 0.2005 re +f* +0.498 0 0.482 rg +359.827 427.714 3.8137 0.2005 re +f* +1 g +363.641 427.714 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 427.714 10.4375 0.2005 re +f* +1 g +377.691 427.714 2.4086 0.2005 re +f* +0.498 0 0.482 rg +380.099 427.714 6.0215 0.2005 re +f* +1 g +386.121 427.714 1.2043 0.2005 re +f* +0.498 0 0.482 rg +387.325 427.714 0.8029 0.2005 re +f* +1 g +388.128 427.714 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 427.714 10.4374 0.2005 re +f* +1 g +402.179 427.714 2.4086 0.2005 re +f* +0.498 0 0.482 rg +404.587 427.714 5.4195 0.2005 re +f* +1 g +410.007 427.714 2.6093 0.2005 re +f* +0.498 0 0.482 rg +412.616 427.714 4.0144 0.2005 re +f* +0 g +251.238 427.915 20.2727 0.2006 re +f* +1 g +271.51 427.915 7.4266 0.2006 re +f* +0 g +278.937 427.915 16.0575 0.2006 re +f* +1 g +294.994 427.915 3.613 0.2006 re +f* +0 g +298.607 427.915 0.6021 0.2006 re +f* +1 g +299.209 427.915 1.0036 0.2006 re +f* +0 g +300.213 427.915 3.8137 0.2006 re +f* +1 g +304.027 427.915 3.4123 0.2006 re +f* +0 g +307.439 427.915 5.8208 0.2006 re +f* +1 g +313.26 427.915 2.6093 0.2006 re +f* +0 g +315.869 427.915 7.0252 0.2006 re +f* +1 g +322.894 427.915 2.208 0.2006 re +f* +0 g +325.102 427.915 8.2294 0.2006 re +f* +1 g +333.332 427.915 2.8101 0.2006 re +f* +0 g +336.142 427.915 6.423 0.2006 re +f* +1 g +342.565 427.915 3.0108 0.2006 re +f* +0 g +345.576 427.915 5.2188 0.2006 re +f* +1 g +350.794 427.915 8.8316 0.2006 re +f* +0.498 0 0.482 rg +359.626 427.915 4.0144 0.2006 re +f* +1 g +363.641 427.915 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 427.915 10.6382 0.2006 re +f* +1 g +377.892 427.915 2.4086 0.2006 re +f* +0.498 0 0.482 rg +380.3 427.915 5.6201 0.2006 re +f* +1 g +385.92 427.915 1.2043 0.2006 re +f* +0.498 0 0.482 rg +387.125 427.915 1.0036 0.2006 re +f* +1 g +388.128 427.915 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 427.915 10.8388 0.2006 re +f* +1 g +402.58 427.915 2.208 0.2006 re +f* +0.498 0 0.482 rg +404.788 427.915 5.018 0.2006 re +f* +1 g +409.806 427.915 2.6093 0.2006 re +f* +0.498 0 0.482 rg +412.415 427.915 4.2151 0.2006 re +f* +0 g +251.238 428.115 20.2727 0.2006 re +f* +1 g +271.51 428.115 7.4266 0.2006 re +f* +0 g +278.937 428.115 16.0575 0.2006 re +f* +1 g +294.994 428.115 3.613 0.2006 re +f* +0 g +298.607 428.115 0.8029 0.2006 re +f* +1 g +299.41 428.115 1.0036 0.2006 re +f* +0 g +300.414 428.115 3.6129 0.2006 re +f* +1 g +304.027 428.115 3.4123 0.2006 re +f* +0 g +307.439 428.115 6.0215 0.2006 re +f* +1 g +313.461 428.115 2.4086 0.2006 re +f* +0 g +315.869 428.115 6.8246 0.2006 re +f* +1 g +322.694 428.115 2.2078 0.2006 re +f* +0 g +324.902 428.115 8.631 0.2006 re +f* +1 g +333.533 428.115 2.6093 0.2006 re +f* +0 g +336.142 428.115 6.423 0.2006 re +f* +1 g +342.565 428.115 2.8101 0.2006 re +f* +0 g +345.375 428.115 5.2187 0.2006 re +f* +1 g +350.594 428.115 9.0324 0.2006 re +f* +0.498 0 0.482 rg +359.626 428.115 4.0144 0.2006 re +f* +1 g +363.641 428.115 3.6129 0.2006 re +f* +0.498 0 0.482 rg +367.253 428.115 11.0396 0.2006 re +f* +1 g +378.293 428.115 2.2079 0.2006 re +f* +0.498 0 0.482 rg +380.501 428.115 5.018 0.2006 re +f* +1 g +385.519 428.115 1.4051 0.2006 re +f* +0.498 0 0.482 rg +386.924 428.115 1.2042 0.2006 re +f* +1 g +388.128 428.115 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 428.115 11.0396 0.2006 re +f* +1 g +402.781 428.115 2.2079 0.2006 re +f* +0.498 0 0.482 rg +404.989 428.115 4.6165 0.2006 re +f* +1 g +409.605 428.115 2.4087 0.2006 re +f* +0.498 0 0.482 rg +412.014 428.115 4.6165 0.2006 re +f* +0 g +251.238 428.316 20.2727 0.2005 re +f* +1 g +271.51 428.316 7.4266 0.2005 re +f* +0 g +278.937 428.316 16.0575 0.2005 re +f* +1 g +294.994 428.316 3.613 0.2005 re +f* +0 g +298.607 428.316 0.8029 0.2005 re +f* +1 g +299.41 428.316 1.2043 0.2005 re +f* +0 g +300.615 428.316 3.4122 0.2005 re +f* +1 g +304.027 428.316 3.2115 0.2005 re +f* +0 g +307.238 428.316 6.4231 0.2005 re +f* +1 g +313.661 428.316 2.4086 0.2005 re +f* +0 g +316.07 428.316 6.6238 0.2005 re +f* +1 g +322.694 428.316 2.0071 0.2005 re +f* +0 g +324.701 428.316 9.0324 0.2005 re +f* +1 g +333.733 428.316 2.6094 0.2005 re +f* +0 g +336.343 428.316 6.0215 0.2005 re +f* +1 g +342.364 428.316 3.0108 0.2005 re +f* +0 g +345.375 428.316 5.018 0.2005 re +f* +1 g +350.393 428.316 9.2331 0.2005 re +f* +0.498 0 0.482 rg +359.626 428.316 1.0036 0.2005 re +f* +1 g +360.63 428.316 0.2007 0.2005 re +f* +0.498 0 0.482 rg +360.83 428.316 2.8101 0.2005 re +f* +1 g +363.641 428.316 3.6129 0.2005 re +f* +0.498 0 0.482 rg +367.253 428.316 11.2403 0.2005 re +f* +1 g +378.494 428.316 2.4087 0.2005 re +f* +0.498 0 0.482 rg +380.902 428.316 4.215 0.2005 re +f* +1 g +385.117 428.316 1.6058 0.2005 re +f* +0.498 0 0.482 rg +386.723 428.316 1.405 0.2005 re +f* +1 g +388.128 428.316 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 428.316 11.441 0.2005 re +f* +1 g +403.182 428.316 2.2079 0.2005 re +f* +0.498 0 0.482 rg +405.39 428.316 3.8137 0.2005 re +f* +1 g +409.204 428.316 2.6093 0.2005 re +f* +0.498 0 0.482 rg +411.813 428.316 4.8173 0.2005 re +f* +0 g +251.438 428.516 20.072 0.2006 re +f* +1 g +271.51 428.516 7.4266 0.2006 re +f* +0 g +278.937 428.516 16.0575 0.2006 re +f* +1 g +294.994 428.516 3.613 0.2006 re +f* +0 g +298.607 428.516 1.0036 0.2006 re +f* +1 g +299.611 428.516 1.2043 0.2006 re +f* +0 g +300.815 428.516 3.2115 0.2006 re +f* +1 g +304.027 428.516 3.2115 0.2006 re +f* +0 g +307.238 428.516 6.8245 0.2006 re +f* +1 g +314.063 428.516 2.2079 0.2006 re +f* +0 g +316.271 428.516 6.2223 0.2006 re +f* +1 g +322.493 428.516 2.0072 0.2006 re +f* +0 g +324.5 428.516 9.4338 0.2006 re +f* +1 g +333.934 428.516 2.6094 0.2006 re +f* +0 g +336.543 428.516 5.8208 0.2006 re +f* +1 g +342.364 428.516 2.8101 0.2006 re +f* +0 g +345.174 428.516 5.2187 0.2006 re +f* +1 g +350.393 428.516 9.2331 0.2006 re +f* +0.498 0 0.482 rg +359.626 428.516 1.0036 0.2006 re +f* +1 g +360.63 428.516 6.6237 0.2006 re +f* +0.498 0 0.482 rg +367.253 428.516 11.6418 0.2006 re +f* +1 g +378.895 428.516 2.4086 0.2006 re +f* +0.498 0 0.482 rg +381.304 428.516 3.4122 0.2006 re +f* +1 g +384.716 428.516 1.6057 0.2006 re +f* +0.498 0 0.482 rg +386.322 428.516 1.8065 0.2006 re +f* +1 g +388.128 428.516 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 428.516 11.6417 0.2006 re +f* +1 g +403.383 428.516 2.4087 0.2006 re +f* +0.498 0 0.482 rg +405.792 428.516 3.0108 0.2006 re +f* +1 g +408.802 428.516 2.6093 0.2006 re +f* +0.498 0 0.482 rg +411.412 428.516 5.018 0.2006 re +f* +0 g +251.438 428.717 20.072 0.2005 re +f* +1 g +271.51 428.717 7.4266 0.2005 re +f* +0 g +278.937 428.717 16.0575 0.2005 re +f* +1 g +294.994 428.717 3.613 0.2005 re +f* +0 g +298.607 428.717 1.2043 0.2005 re +f* +1 g +299.812 428.717 1.2043 0.2005 re +f* +0 g +301.016 428.717 3.0108 0.2005 re +f* +1 g +304.027 428.717 3.2115 0.2005 re +f* +0 g +307.238 428.717 7.0252 0.2005 re +f* +1 g +314.263 428.717 2.2079 0.2005 re +f* +0 g +316.471 428.717 6.0216 0.2005 re +f* +1 g +322.493 428.717 1.8065 0.2005 re +f* +0 g +324.299 428.717 10.0359 0.2005 re +f* +1 g +334.335 428.717 2.4087 0.2005 re +f* +0 g +336.744 428.717 5.4194 0.2005 re +f* +1 g +342.163 428.717 2.81 0.2005 re +f* +0 g +344.973 428.717 5.2188 0.2005 re +f* +1 g +350.192 428.717 9.4338 0.2005 re +f* +0.498 0 0.482 rg +359.626 428.717 1.0036 0.2005 re +f* +1 g +360.63 428.717 6.6237 0.2005 re +f* +0.498 0 0.482 rg +367.253 428.717 12.0432 0.2005 re +f* +1 g +379.297 428.717 2.81 0.2005 re +f* +0.498 0 0.482 rg +382.107 428.717 1.8066 0.2005 re +f* +1 g +383.913 428.717 2.2078 0.2005 re +f* +0.498 0 0.482 rg +386.121 428.717 2.0072 0.2005 re +f* +1 g +388.128 428.717 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 428.717 12.0432 0.2005 re +f* +1 g +403.784 428.717 2.81 0.2005 re +f* +0.498 0 0.482 rg +406.594 428.717 1.6058 0.2005 re +f* +1 g +408.2 428.717 2.8101 0.2005 re +f* +0.498 0 0.482 rg +411.01 428.717 5.4194 0.2005 re +f* +0 g +251.438 428.918 20.072 0.2006 re +f* +1 g +271.51 428.918 7.4266 0.2006 re +f* +0 g +278.937 428.918 16.0575 0.2006 re +f* +1 g +294.994 428.918 3.613 0.2006 re +f* +0 g +298.607 428.918 1.405 0.2006 re +f* +1 g +300.012 428.918 1.2043 0.2006 re +f* +0 g +301.217 428.918 2.8101 0.2006 re +f* +1 g +304.027 428.918 3.0108 0.2006 re +f* +0 g +307.038 428.918 7.4266 0.2006 re +f* +1 g +314.464 428.918 2.2079 0.2006 re +f* +0 g +316.672 428.918 5.6202 0.2006 re +f* +1 g +322.292 428.918 1.8065 0.2006 re +f* +0 g +324.099 428.918 10.4374 0.2006 re +f* +1 g +334.536 428.918 2.4086 0.2006 re +f* +0 g +336.945 428.918 5.018 0.2006 re +f* +1 g +341.963 428.918 2.8101 0.2006 re +f* +0 g +344.773 428.918 5.2186 0.2006 re +f* +1 g +349.991 428.918 9.6346 0.2006 re +f* +0.498 0 0.482 rg +359.626 428.918 1.0036 0.2006 re +f* +1 g +360.63 428.918 6.6237 0.2006 re +f* +0.498 0 0.482 rg +367.253 428.918 12.4447 0.2006 re +f* +1 g +379.698 428.918 6.0215 0.2006 re +f* +0.498 0 0.482 rg +385.72 428.918 2.4086 0.2006 re +f* +1 g +388.128 428.918 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 428.918 12.6453 0.2006 re +f* +1 g +404.386 428.918 6.2223 0.2006 re +f* +0.498 0 0.482 rg +410.609 428.918 5.8209 0.2006 re +f* +0 g +251.438 429.118 20.2727 0.2006 re +f* +1 g +271.711 429.118 7.2259 0.2006 re +f* +0 g +278.937 429.118 16.0575 0.2006 re +f* +1 g +294.994 429.118 3.613 0.2006 re +f* +0 g +298.607 429.118 1.6057 0.2006 re +f* +1 g +300.213 429.118 1.2044 0.2006 re +f* +0 g +301.417 429.118 2.4086 0.2006 re +f* +1 g +303.826 429.118 3.2115 0.2006 re +f* +0 g +307.038 429.118 7.828 0.2006 re +f* +1 g +314.866 429.118 2.0072 0.2006 re +f* +0 g +316.873 429.118 5.2188 0.2006 re +f* +1 g +322.092 429.118 1.8064 0.2006 re +f* +0 g +323.898 429.118 10.8389 0.2006 re +f* +1 g +334.737 429.118 2.4086 0.2006 re +f* +0 g +337.146 429.118 4.6166 0.2006 re +f* +1 g +341.762 429.118 2.6093 0.2006 re +f* +0 g +344.371 429.118 5.4195 0.2006 re +f* +1 g +349.791 429.118 9.8352 0.2006 re +f* +0.498 0 0.482 rg +359.626 429.118 20.4734 0.2006 re +f* +1 g +380.099 429.118 5.2187 0.2006 re +f* +0.498 0 0.482 rg +385.318 429.118 2.81 0.2006 re +f* +1 g +388.128 429.118 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 429.118 13.0468 0.2006 re +f* +1 g +404.788 429.118 5.4194 0.2006 re +f* +0.498 0 0.482 rg +410.207 429.118 6.2223 0.2006 re +f* +0 g +251.639 429.319 20.0719 0.2005 re +f* +1 g +271.711 429.319 7.2259 0.2005 re +f* +0 g +278.937 429.319 16.0575 0.2005 re +f* +1 g +294.994 429.319 3.613 0.2005 re +f* +0 g +298.607 429.319 1.8065 0.2005 re +f* +1 g +300.414 429.319 1.405 0.2005 re +f* +0 g +301.819 429.319 1.8065 0.2005 re +f* +1 g +303.625 429.319 3.2115 0.2005 re +f* +0 g +306.837 429.319 8.4302 0.2005 re +f* +1 g +315.267 429.319 1.8065 0.2005 re +f* +0 g +317.074 429.319 4.8172 0.2005 re +f* +1 g +321.891 429.319 1.6058 0.2005 re +f* +0 g +323.497 429.319 11.6417 0.2005 re +f* +1 g +335.138 429.319 2.208 0.2005 re +f* +0 g +337.346 429.319 4.2151 0.2005 re +f* +1 g +341.561 429.319 2.6093 0.2005 re +f* +0 g +344.171 429.319 5.6202 0.2005 re +f* +1 g +349.791 429.319 9.8352 0.2005 re +f* +0.498 0 0.482 rg +359.626 429.319 21.2763 0.2005 re +f* +1 g +380.902 429.319 3.8136 0.2005 re +f* +0.498 0 0.482 rg +384.716 429.319 3.4122 0.2005 re +f* +1 g +388.128 429.319 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 429.319 13.8497 0.2005 re +f* +1 g +405.591 429.319 3.8136 0.2005 re +f* +0.498 0 0.482 rg +409.404 429.319 6.8244 0.2005 re +f* +0 g +251.639 429.519 20.0719 0.2005 re +f* +1 g +271.711 429.519 7.2259 0.2005 re +f* +0 g +278.937 429.519 13.0467 0.2005 re +f* +1 g +291.984 429.519 0.2008 0.2005 re +f* +0 g +292.184 429.519 2.81 0.2005 re +f* +1 g +294.994 429.519 3.613 0.2005 re +f* +0 g +298.607 429.519 2.0072 0.2005 re +f* +1 g +300.615 429.519 1.6057 0.2005 re +f* +0 g +302.22 429.519 1.2044 0.2005 re +f* +1 g +303.425 429.519 3.2115 0.2005 re +f* +0 g +306.636 429.519 9.0324 0.2005 re +f* +1 g +315.669 429.519 1.8064 0.2005 re +f* +0 g +317.475 429.519 4.2152 0.2005 re +f* +1 g +321.69 429.519 1.405 0.2005 re +f* +0 g +323.095 429.519 12.2439 0.2005 re +f* +1 g +335.339 429.519 2.4086 0.2005 re +f* +0 g +337.748 429.519 3.6129 0.2005 re +f* +1 g +341.361 429.519 2.4087 0.2005 re +f* +0 g +343.769 429.519 5.8208 0.2005 re +f* +1 g +349.59 429.519 10.036 0.2005 re +f* +0.498 0 0.482 rg +359.626 429.519 22.4805 0.2005 re +f* +1 g +382.107 429.519 1.4051 0.2005 re +f* +0.498 0 0.482 rg +383.512 429.519 4.6165 0.2005 re +f* +1 g +388.128 429.519 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 429.519 15.054 0.2005 re +f* +1 g +406.795 429.519 1.6057 0.2005 re +f* +0.498 0 0.482 rg +408.401 429.519 7.828 0.2005 re +f* +0 g +251.639 429.72 20.0719 0.2006 re +f* +1 g +271.711 429.72 7.2259 0.2006 re +f* +0 g +278.937 429.72 13.0467 0.2006 re +f* +1 g +291.984 429.72 6.6238 0.2006 re +f* +0 g +298.607 429.72 2.2079 0.2006 re +f* +1 g +300.815 429.72 5.6202 0.2006 re +f* +0 g +306.435 429.72 9.6345 0.2006 re +f* +1 g +316.07 429.72 1.8064 0.2006 re +f* +0 g +317.876 429.72 3.4123 0.2006 re +f* +1 g +321.289 429.72 1.4051 0.2006 re +f* +0 g +322.694 429.72 13.0467 0.2006 re +f* +1 g +335.74 429.72 2.6093 0.2006 re +f* +0 g +338.35 429.72 2.4087 0.2006 re +f* +1 g +340.758 429.72 2.81 0.2006 re +f* +0 g +343.568 429.72 5.8209 0.2006 re +f* +1 g +349.389 429.72 10.2367 0.2006 re +f* +0.498 0 0.482 rg +359.626 429.72 28.5021 0.2006 re +f* +1 g +388.128 429.72 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 429.72 24.4877 0.2006 re +f* +0 g +251.639 429.92 20.0719 0.2006 re +f* +1 g +271.711 429.92 7.2259 0.2006 re +f* +0 g +278.937 429.92 13.0467 0.2006 re +f* +1 g +291.984 429.92 6.6238 0.2006 re +f* +0 g +298.607 429.92 2.6093 0.2006 re +f* +1 g +301.217 429.92 5.018 0.2006 re +f* +0 g +306.235 429.92 10.4374 0.2006 re +f* +1 g +316.672 429.92 2.0073 0.2006 re +f* +0 g +318.679 429.92 1.8064 0.2006 re +f* +1 g +320.486 429.92 1.6058 0.2006 re +f* +0 g +322.092 429.92 14.0503 0.2006 re +f* +1 g +336.142 429.92 7.0252 0.2006 re +f* +0 g +343.167 429.92 6.0216 0.2006 re +f* +1 g +349.189 429.92 10.2367 0.2006 re +f* +0.498 0 0.482 rg +359.425 429.92 28.7028 0.2006 re +f* +1 g +388.128 429.92 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 429.92 24.2871 0.2006 re +f* +0 g +251.84 430.121 19.8712 0.2006 re +f* +1 g +271.711 430.121 7.2259 0.2006 re +f* +0 g +278.937 430.121 13.0467 0.2006 re +f* +1 g +291.984 430.121 6.6238 0.2006 re +f* +0 g +298.607 430.121 2.8101 0.2006 re +f* +1 g +301.417 430.121 4.4158 0.2006 re +f* +0 g +305.833 430.121 11.6417 0.2006 re +f* +1 g +317.475 430.121 4.0144 0.2006 re +f* +0 g +321.489 430.121 15.2547 0.2006 re +f* +1 g +336.744 430.121 6.0216 0.2006 re +f* +0 g +342.766 430.121 6.2222 0.2006 re +f* +1 g +348.988 430.121 10.4375 0.2006 re +f* +0.498 0 0.482 rg +359.425 430.121 28.7028 0.2006 re +f* +1 g +388.128 430.121 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 430.121 24.2871 0.2006 re +f* +0 g +251.84 430.322 19.8712 0.2005 re +f* +1 g +271.711 430.322 7.2259 0.2005 re +f* +0 g +278.937 430.322 23.0827 0.2005 re +f* +1 g +302.02 430.322 3.4123 0.2005 re +f* +0 g +305.432 430.322 13.4481 0.2005 re +f* +1 g +318.88 430.322 1.6058 0.2005 re +f* +0 g +320.486 430.322 16.8605 0.2005 re +f* +1 g +337.346 430.322 4.8172 0.2005 re +f* +0 g +342.163 430.322 6.6238 0.2005 re +f* +1 g +348.787 430.322 10.6381 0.2005 re +f* +0.498 0 0.482 rg +359.425 430.322 28.7028 0.2005 re +f* +1 g +388.128 430.322 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 430.322 24.2871 0.2005 re +f* +0 g +251.84 430.522 19.8712 0.2006 re +f* +1 g +271.711 430.522 7.2259 0.2006 re +f* +0 g +278.937 430.522 23.6849 0.2006 re +f* +1 g +302.622 430.522 2.2079 0.2006 re +f* +0 g +304.83 430.522 33.3194 0.2006 re +f* +1 g +338.149 430.522 3.2115 0.2006 re +f* +0 g +341.361 430.522 7.2259 0.2006 re +f* +1 g +348.586 430.522 10.8389 0.2006 re +f* +0.498 0 0.482 rg +359.425 430.522 28.7028 0.2006 re +f* +1 g +388.128 430.522 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 430.522 24.0863 0.2006 re +f* +0 g +252.04 430.723 19.8712 0.2005 re +f* +1 g +271.912 430.723 7.0252 0.2005 re +f* +0 g +278.937 430.723 69.4489 0.2005 re +f* +1 g +348.386 430.723 11.0396 0.2005 re +f* +0.498 0 0.482 rg +359.425 430.723 28.7028 0.2005 re +f* +1 g +388.128 430.723 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 430.723 24.0863 0.2005 re +f* +0 g +252.04 430.923 19.8712 0.2006 re +f* +1 g +271.912 430.923 7.0252 0.2006 re +f* +0 g +278.937 430.923 69.2482 0.2006 re +f* +1 g +348.185 430.923 11.0395 0.2006 re +f* +0.498 0 0.482 rg +359.225 430.923 28.9036 0.2006 re +f* +1 g +388.128 430.923 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 430.923 24.0863 0.2006 re +f* +0 g +252.04 431.124 19.8712 0.2006 re +f* +1 g +271.912 431.124 7.0252 0.2006 re +f* +0 g +278.937 431.124 69.0474 0.2006 re +f* +1 g +347.984 431.124 11.2403 0.2006 re +f* +0.498 0 0.482 rg +359.225 431.124 28.9036 0.2006 re +f* +1 g +388.128 431.124 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 431.124 23.8856 0.2006 re +f* +0 g +252.241 431.324 19.6705 0.2005 re +f* +1 g +271.912 431.324 7.0252 0.2005 re +f* +0 g +278.937 431.324 68.8468 0.2005 re +f* +1 g +347.784 431.324 11.4409 0.2005 re +f* +0.498 0 0.482 rg +359.225 431.324 28.9036 0.2005 re +f* +1 g +388.128 431.324 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 431.324 23.8856 0.2005 re +f* +0 g +252.241 431.525 19.6705 0.2005 re +f* +1 g +271.912 431.525 7.0252 0.2005 re +f* +0 g +278.937 431.525 68.4453 0.2005 re +f* +1 g +347.382 431.525 11.8424 0.2005 re +f* +0.498 0 0.482 rg +359.225 431.525 28.9036 0.2005 re +f* +1 g +388.128 431.525 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 431.525 23.8856 0.2005 re +f* +0 g +252.241 431.725 19.6705 0.2006 re +f* +1 g +271.912 431.725 7.0252 0.2006 re +f* +0 g +278.937 431.725 68.2446 0.2006 re +f* +1 g +347.181 431.725 11.8424 0.2006 re +f* +0.498 0 0.482 rg +359.024 431.725 29.1043 0.2006 re +f* +1 g +388.128 431.725 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 431.725 23.6849 0.2006 re +f* +0 g +252.442 431.926 19.6705 0.2006 re +f* +1 g +272.112 431.926 6.8245 0.2006 re +f* +0 g +278.937 431.926 68.0438 0.2006 re +f* +1 g +346.981 431.926 12.0432 0.2006 re +f* +0.498 0 0.482 rg +359.024 431.926 29.1043 0.2006 re +f* +1 g +388.128 431.926 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 431.926 23.6849 0.2006 re +f* +0 g +252.442 432.127 19.6705 0.2005 re +f* +1 g +272.112 432.127 6.8245 0.2005 re +f* +0 g +278.937 432.127 67.6424 0.2005 re +f* +1 g +346.579 432.127 12.4446 0.2005 re +f* +0.498 0 0.482 rg +359.024 432.127 29.1043 0.2005 re +f* +1 g +388.128 432.127 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 432.127 23.4841 0.2005 re +f* +0 g +252.643 432.327 19.4697 0.2005 re +f* +1 g +272.112 432.327 6.8245 0.2005 re +f* +0 g +278.937 432.327 67.4417 0.2005 re +f* +1 g +346.379 432.327 12.6453 0.2005 re +f* +0.498 0 0.482 rg +359.024 432.327 29.1043 0.2005 re +f* +1 g +388.128 432.327 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 432.327 23.4841 0.2005 re +f* +0 g +252.643 432.528 19.4697 0.2006 re +f* +1 g +272.112 432.528 6.8245 0.2006 re +f* +0 g +278.937 432.528 67.0402 0.2006 re +f* +1 g +345.977 432.528 12.8461 0.2006 re +f* +0.498 0 0.482 rg +358.823 432.528 29.305 0.2006 re +f* +1 g +388.128 432.528 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 432.528 23.4841 0.2006 re +f* +0 g +252.643 432.728 19.6705 0.2006 re +f* +1 g +272.313 432.728 6.6237 0.2006 re +f* +0 g +278.937 432.728 66.8396 0.2006 re +f* +1 g +345.776 432.728 13.0467 0.2006 re +f* +0.498 0 0.482 rg +358.823 432.728 29.305 0.2006 re +f* +1 g +388.128 432.728 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 432.728 23.2835 0.2006 re +f* +0 g +252.843 432.929 19.4698 0.2006 re +f* +1 g +272.313 432.929 6.6237 0.2006 re +f* +0 g +278.937 432.929 66.4381 0.2006 re +f* +1 g +345.375 432.929 13.4482 0.2006 re +f* +0.498 0 0.482 rg +358.823 432.929 29.305 0.2006 re +f* +1 g +388.128 432.929 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 432.929 23.2835 0.2006 re +f* +0 g +252.843 433.129 19.4698 0.2006 re +f* +1 g +272.313 433.129 6.6237 0.2006 re +f* +0 g +278.937 433.129 66.0366 0.2006 re +f* +1 g +344.973 433.129 13.649 0.2006 re +f* +0.498 0 0.482 rg +358.623 433.129 29.5057 0.2006 re +f* +1 g +388.128 433.129 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 433.129 23.2835 0.2006 re +f* +0 g +253.044 433.33 19.2691 0.2005 re +f* +1 g +272.313 433.33 6.8244 0.2005 re +f* +0 g +279.138 433.33 65.4345 0.2005 re +f* +1 g +344.572 433.33 14.0504 0.2005 re +f* +0.498 0 0.482 rg +358.623 433.33 29.5057 0.2005 re +f* +1 g +388.128 433.33 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 433.33 23.0827 0.2005 re +f* +0 g +253.044 433.53 19.4698 0.2005 re +f* +1 g +272.514 433.53 6.6237 0.2005 re +f* +0 g +279.138 433.53 65.0331 0.2005 re +f* +1 g +344.171 433.53 14.2511 0.2005 re +f* +0.498 0 0.482 rg +358.422 433.53 29.7064 0.2005 re +f* +1 g +388.128 433.53 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 433.53 23.0827 0.2005 re +f* +0 g +253.044 433.731 19.4698 0.2006 re +f* +1 g +272.514 433.731 6.6237 0.2006 re +f* +0 g +279.138 433.731 64.6317 0.2006 re +f* +1 g +343.769 433.731 14.6525 0.2006 re +f* +0.498 0 0.482 rg +358.422 433.731 29.7064 0.2006 re +f* +1 g +388.128 433.731 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 433.731 22.882 0.2006 re +f* +0 g +253.245 433.932 19.2691 0.2006 re +f* +1 g +272.514 433.932 6.6237 0.2006 re +f* +0 g +279.138 433.932 64.2302 0.2006 re +f* +1 g +343.368 433.932 14.8532 0.2006 re +f* +0.498 0 0.482 rg +358.221 433.932 29.9072 0.2006 re +f* +1 g +388.128 433.932 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 433.932 22.882 0.2006 re +f* +0 g +253.245 434.132 19.2691 0.2005 re +f* +1 g +272.514 434.132 6.6237 0.2005 re +f* +0 g +279.138 434.132 63.8288 0.2005 re +f* +1 g +342.966 434.132 15.2546 0.2005 re +f* +0.498 0 0.482 rg +358.221 434.132 29.9072 0.2005 re +f* +1 g +388.128 434.132 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 434.132 22.6813 0.2005 re +f* +0 g +253.445 434.333 19.2691 0.2006 re +f* +1 g +272.715 434.333 6.423 0.2006 re +f* +0 g +279.138 434.333 15.4554 0.2006 re +f* +1 g +294.593 434.333 2.4086 0.2006 re +f* +0 g +297.002 434.333 45.3626 0.2006 re +f* +1 g +342.364 434.333 15.6561 0.2006 re +f* +0.498 0 0.482 rg +358.02 434.333 30.1079 0.2006 re +f* +1 g +388.128 434.333 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 434.333 22.6813 0.2006 re +f* +0 g +253.445 434.533 19.2691 0.2005 re +f* +1 g +272.715 434.533 6.423 0.2005 re +f* +0 g +279.138 434.533 14.6525 0.2005 re +f* +1 g +293.79 434.533 3.8137 0.2005 re +f* +0 g +297.604 434.533 44.359 0.2005 re +f* +1 g +341.963 434.533 16.0575 0.2005 re +f* +0.498 0 0.482 rg +358.02 434.533 30.1079 0.2005 re +f* +1 g +388.128 434.533 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 434.533 22.4805 0.2005 re +f* +0 g +253.646 434.734 19.0683 0.2006 re +f* +1 g +272.715 434.734 6.423 0.2006 re +f* +0 g +279.138 434.734 14.0504 0.2006 re +f* +1 g +293.188 434.734 4.8172 0.2006 re +f* +0 g +298.005 434.734 43.3554 0.2006 re +f* +1 g +341.361 434.734 16.459 0.2006 re +f* +0.498 0 0.482 rg +357.82 434.734 30.3086 0.2006 re +f* +1 g +388.128 434.734 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 434.734 22.4805 0.2006 re +f* +0 g +253.646 434.934 19.269 0.2005 re +f* +1 g +272.915 434.934 6.2223 0.2005 re +f* +0 g +279.138 434.934 13.6489 0.2005 re +f* +1 g +292.786 434.934 5.6202 0.2005 re +f* +0 g +298.407 434.934 42.3518 0.2005 re +f* +1 g +340.758 434.934 17.0611 0.2005 re +f* +0.498 0 0.482 rg +357.82 434.934 30.3086 0.2005 re +f* +1 g +388.128 434.934 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 434.934 22.4805 0.2005 re +f* +0 g +253.847 435.135 19.0683 0.2006 re +f* +1 g +272.915 435.135 6.2223 0.2006 re +f* +0 g +279.138 435.135 13.2475 0.2006 re +f* +1 g +292.385 435.135 6.2223 0.2006 re +f* +0 g +298.607 435.135 41.5489 0.2006 re +f* +1 g +340.156 435.135 17.4626 0.2006 re +f* +0.498 0 0.482 rg +357.619 435.135 30.5093 0.2006 re +f* +1 g +388.128 435.135 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 435.135 22.2799 0.2006 re +f* +0 g +253.847 435.335 19.0683 0.2005 re +f* +1 g +272.915 435.335 6.2223 0.2005 re +f* +0 g +279.138 435.335 13.0468 0.2005 re +f* +1 g +292.184 435.335 6.6237 0.2005 re +f* +0 g +298.808 435.335 40.7461 0.2005 re +f* +1 g +339.554 435.335 17.864 0.2005 re +f* +0.498 0 0.482 rg +357.418 435.335 30.71 0.2005 re +f* +1 g +388.128 435.335 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 435.335 22.2799 0.2005 re +f* +0 g +254.048 435.536 19.0683 0.2006 re +f* +1 g +273.116 435.536 6.0216 0.2006 re +f* +0 g +279.138 435.536 13.0468 0.2006 re +f* +1 g +292.184 435.536 6.8244 0.2006 re +f* +0 g +299.009 435.536 39.7425 0.2006 re +f* +1 g +338.751 435.536 18.6669 0.2006 re +f* +0.498 0 0.482 rg +357.418 435.536 30.71 0.2006 re +f* +1 g +388.128 435.536 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 435.536 22.0791 0.2006 re +f* +0 g +254.048 435.737 19.0683 0.2006 re +f* +1 g +273.116 435.737 6.0216 0.2006 re +f* +0 g +279.138 435.737 12.846 0.2006 re +f* +1 g +291.984 435.737 7.0252 0.2006 re +f* +0 g +299.009 435.737 39.1403 0.2006 re +f* +1 g +338.149 435.737 19.0683 0.2006 re +f* +0.498 0 0.482 rg +357.217 435.737 30.9108 0.2006 re +f* +1 g +388.128 435.737 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 435.737 22.0791 0.2006 re +f* +0 g +254.248 435.937 19.0683 0.2006 re +f* +1 g +273.317 435.937 5.8209 0.2006 re +f* +0 g +279.138 435.937 12.6453 0.2006 re +f* +1 g +291.783 435.937 7.4266 0.2006 re +f* +0 g +299.209 435.937 38.3375 0.2006 re +f* +1 g +337.547 435.937 19.4697 0.2006 re +f* +0.498 0 0.482 rg +357.017 435.937 31.1115 0.2006 re +f* +1 g +388.128 435.937 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 435.937 21.8784 0.2006 re +f* +0 g +254.248 436.138 19.0683 0.2005 re +f* +1 g +273.317 436.138 6.0216 0.2005 re +f* +0 g +279.338 436.138 12.4446 0.2005 re +f* +1 g +291.783 436.138 7.4266 0.2005 re +f* +0 g +299.209 436.138 37.7353 0.2005 re +f* +1 g +336.945 436.138 20.0719 0.2005 re +f* +0.498 0 0.482 rg +357.017 436.138 7.4267 0.2005 re +f* +1 g +364.443 436.138 1.8064 0.2005 re +f* +0.498 0 0.482 rg +366.25 436.138 21.8784 0.2005 re +f* +1 g +388.128 436.138 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 436.138 21.8784 0.2005 re +f* +0 g +254.449 436.338 19.0684 0.2005 re +f* +1 g +273.517 436.338 5.8208 0.2005 re +f* +0 g +279.338 436.338 12.4446 0.2005 re +f* +1 g +291.783 436.338 7.6274 0.2005 re +f* +0 g +299.41 436.338 36.9324 0.2005 re +f* +1 g +336.343 436.338 20.4733 0.2005 re +f* +0.498 0 0.482 rg +356.816 436.338 7.2259 0.2005 re +f* +1 g +364.042 436.338 2.6094 0.2005 re +f* +0.498 0 0.482 rg +366.651 436.338 21.4769 0.2005 re +f* +1 g +388.128 436.338 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 436.338 21.6777 0.2005 re +f* +0 g +254.449 436.539 19.0684 0.2006 re +f* +1 g +273.517 436.539 5.8208 0.2006 re +f* +0 g +279.338 436.539 12.4446 0.2006 re +f* +1 g +291.783 436.539 7.8281 0.2006 re +f* +0 g +299.611 436.539 35.9288 0.2006 re +f* +1 g +335.54 436.539 21.0755 0.2006 re +f* +0.498 0 0.482 rg +356.615 436.539 7.2259 0.2006 re +f* +1 g +363.841 436.539 3.0108 0.2006 re +f* +0.498 0 0.482 rg +366.852 436.539 21.2762 0.2006 re +f* +1 g +388.128 436.539 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 436.539 21.6777 0.2006 re +f* +0 g +254.65 436.739 19.0684 0.2006 re +f* +1 g +273.718 436.739 5.6201 0.2006 re +f* +0 g +279.338 436.739 12.4446 0.2006 re +f* +1 g +291.783 436.739 7.8281 0.2006 re +f* +0 g +299.611 436.739 35.3266 0.2006 re +f* +1 g +334.938 436.739 21.477 0.2006 re +f* +0.498 0 0.482 rg +356.415 436.739 7.2259 0.2006 re +f* +1 g +363.641 436.739 3.4122 0.2006 re +f* +0.498 0 0.482 rg +367.053 436.739 21.0755 0.2006 re +f* +1 g +388.128 436.739 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 436.739 21.4769 0.2006 re +f* +0 g +254.65 436.94 19.0684 0.2006 re +f* +1 g +273.718 436.94 5.6201 0.2006 re +f* +0 g +279.338 436.94 12.4446 0.2006 re +f* +1 g +291.783 436.94 7.8281 0.2006 re +f* +0 g +299.611 436.94 34.7244 0.2006 re +f* +1 g +334.335 436.94 22.0792 0.2006 re +f* +0.498 0 0.482 rg +356.415 436.94 7.0252 0.2006 re +f* +1 g +363.44 436.94 3.8136 0.2006 re +f* +0.498 0 0.482 rg +367.253 436.94 20.8748 0.2006 re +f* +1 g +388.128 436.94 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 436.94 21.2763 0.2006 re +f* +0 g +254.851 437.141 19.0684 0.2005 re +f* +1 g +273.919 437.141 5.4194 0.2005 re +f* +0 g +279.338 437.141 12.4446 0.2005 re +f* +1 g +291.783 437.141 8.0288 0.2005 re +f* +0 g +299.812 437.141 33.9216 0.2005 re +f* +1 g +333.733 437.141 22.4805 0.2005 re +f* +0.498 0 0.482 rg +356.214 437.141 7.226 0.2005 re +f* +1 g +363.44 437.141 3.8136 0.2005 re +f* +0.498 0 0.482 rg +367.253 437.141 20.8748 0.2005 re +f* +1 g +388.128 437.141 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 437.141 21.2763 0.2005 re +f* +0 g +254.851 437.341 19.0684 0.2005 re +f* +1 g +273.919 437.341 5.4194 0.2005 re +f* +0 g +279.338 437.341 12.4446 0.2005 re +f* +1 g +291.783 437.341 8.0288 0.2005 re +f* +0 g +299.812 437.341 33.3194 0.2005 re +f* +1 g +333.131 437.341 22.882 0.2005 re +f* +0.498 0 0.482 rg +356.013 437.341 7.2259 0.2005 re +f* +1 g +363.239 437.341 4.2152 0.2005 re +f* +0.498 0 0.482 rg +367.454 437.341 20.674 0.2005 re +f* +1 g +388.128 437.341 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 437.341 21.0755 0.2005 re +f* +0 g +255.051 437.542 19.0683 0.2006 re +f* +1 g +274.12 437.542 5.4195 0.2006 re +f* +0 g +279.539 437.542 12.2438 0.2006 re +f* +1 g +291.783 437.542 8.0288 0.2006 re +f* +0 g +299.812 437.542 32.5165 0.2006 re +f* +1 g +332.328 437.542 23.4842 0.2006 re +f* +0.498 0 0.482 rg +355.812 437.542 7.4266 0.2006 re +f* +1 g +363.239 437.542 4.2152 0.2006 re +f* +0.498 0 0.482 rg +367.454 437.542 20.674 0.2006 re +f* +1 g +388.128 437.542 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 437.542 21.0755 0.2006 re +f* +0 g +255.252 437.742 18.8676 0.2006 re +f* +1 g +274.12 437.742 5.4195 0.2006 re +f* +0 g +279.539 437.742 12.2438 0.2006 re +f* +1 g +291.783 437.742 8.0288 0.2006 re +f* +0 g +299.812 437.742 31.9144 0.2006 re +f* +1 g +331.726 437.742 23.8856 0.2006 re +f* +0.498 0 0.482 rg +355.612 437.742 7.6273 0.2006 re +f* +1 g +363.239 437.742 4.2152 0.2006 re +f* +0.498 0 0.482 rg +367.454 437.742 20.674 0.2006 re +f* +1 g +388.128 437.742 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 437.742 20.8748 0.2006 re +f* +0 g +255.252 437.943 19.0683 0.2005 re +f* +1 g +274.32 437.943 5.2188 0.2005 re +f* +0 g +279.539 437.943 12.2438 0.2005 re +f* +1 g +291.783 437.943 8.2295 0.2005 re +f* +0 g +300.012 437.943 31.1115 0.2005 re +f* +1 g +331.124 437.943 24.2871 0.2005 re +f* +0.498 0 0.482 rg +355.411 437.943 7.828 0.2005 re +f* +1 g +363.239 437.943 4.2152 0.2005 re +f* +0.498 0 0.482 rg +367.454 437.943 20.674 0.2005 re +f* +1 g +388.128 437.943 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 437.943 20.8748 0.2005 re +f* +0 g +255.453 438.143 19.0684 0.2006 re +f* +1 g +274.521 438.143 5.018 0.2006 re +f* +0 g +279.539 438.143 12.2438 0.2006 re +f* +1 g +291.783 438.143 8.2295 0.2006 re +f* +0 g +300.012 438.143 30.5094 0.2006 re +f* +1 g +330.522 438.143 24.6885 0.2006 re +f* +0.498 0 0.482 rg +355.21 438.143 8.0287 0.2006 re +f* +1 g +363.239 438.143 4.4159 0.2006 re +f* +0.498 0 0.482 rg +367.655 438.143 20.4733 0.2006 re +f* +1 g +388.128 438.143 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 438.143 20.6741 0.2006 re +f* +0 g +255.453 438.344 19.0684 0.2005 re +f* +1 g +274.521 438.344 5.2186 0.2005 re +f* +0 g +279.74 438.344 12.0432 0.2005 re +f* +1 g +291.783 438.344 8.2295 0.2005 re +f* +0 g +300.012 438.344 29.9072 0.2005 re +f* +1 g +329.92 438.344 25.2907 0.2005 re +f* +0.498 0 0.482 rg +355.21 438.344 8.0287 0.2005 re +f* +1 g +363.239 438.344 4.4159 0.2005 re +f* +0.498 0 0.482 rg +367.655 438.344 20.4733 0.2005 re +f* +1 g +388.128 438.344 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 438.344 20.6741 0.2005 re +f* +0 g +255.653 438.544 19.0683 0.2006 re +f* +1 g +274.722 438.544 5.018 0.2006 re +f* +0 g +279.74 438.544 12.2439 0.2006 re +f* +1 g +291.984 438.544 8.0288 0.2006 re +f* +0 g +300.012 438.544 29.3051 0.2006 re +f* +1 g +329.317 438.544 25.692 0.2006 re +f* +0.498 0 0.482 rg +355.01 438.544 8.2295 0.2006 re +f* +1 g +363.239 438.544 4.2152 0.2006 re +f* +0.498 0 0.482 rg +367.454 438.544 20.674 0.2006 re +f* +1 g +388.128 438.544 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 438.544 20.4734 0.2006 re +f* +0 g +255.653 438.745 19.2691 0.2006 re +f* +1 g +274.922 438.745 4.8172 0.2006 re +f* +0 g +279.74 438.745 12.2439 0.2006 re +f* +1 g +291.984 438.745 8.0288 0.2006 re +f* +0 g +300.012 438.745 28.7029 0.2006 re +f* +1 g +328.715 438.745 26.0935 0.2006 re +f* +0.498 0 0.482 rg +354.809 438.745 8.4302 0.2006 re +f* +1 g +363.239 438.745 4.2152 0.2006 re +f* +0.498 0 0.482 rg +367.454 438.745 20.674 0.2006 re +f* +1 g +388.128 438.745 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 438.745 20.2727 0.2006 re +f* +0 g +255.854 438.946 19.0684 0.2005 re +f* +1 g +274.922 438.946 4.8172 0.2005 re +f* +0 g +279.74 438.946 12.4447 0.2005 re +f* +1 g +292.184 438.946 7.828 0.2005 re +f* +0 g +300.012 438.946 28.1007 0.2005 re +f* +1 g +328.113 438.946 26.2943 0.2005 re +f* +0.498 0 0.482 rg +354.407 438.946 8.8316 0.2005 re +f* +1 g +363.239 438.946 4.2152 0.2005 re +f* +0.498 0 0.482 rg +367.454 438.946 20.674 0.2005 re +f* +1 g +388.128 438.946 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 438.946 20.2727 0.2005 re +f* +0 g +256.055 439.146 19.0683 0.2006 re +f* +1 g +275.123 439.146 4.8173 0.2006 re +f* +0 g +279.94 439.146 12.2439 0.2006 re +f* +1 g +292.184 439.146 7.828 0.2006 re +f* +0 g +300.012 439.146 27.4986 0.2006 re +f* +1 g +327.511 439.146 26.6957 0.2006 re +f* +0.498 0 0.482 rg +354.207 439.146 9.0323 0.2006 re +f* +1 g +363.239 439.146 4.2152 0.2006 re +f* +0.498 0 0.482 rg +367.454 439.146 20.674 0.2006 re +f* +1 g +388.128 439.146 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 439.146 20.0719 0.2006 re +f* +0 g +256.055 439.347 19.269 0.2005 re +f* +1 g +275.324 439.347 4.6166 0.2005 re +f* +0 g +279.94 439.347 12.4446 0.2005 re +f* +1 g +292.385 439.347 7.6273 0.2005 re +f* +0 g +300.012 439.347 26.8964 0.2005 re +f* +1 g +326.909 439.347 27.0971 0.2005 re +f* +0.498 0 0.482 rg +354.006 439.347 9.4339 0.2005 re +f* +1 g +363.44 439.347 3.8136 0.2005 re +f* +0.498 0 0.482 rg +367.253 439.347 20.8748 0.2005 re +f* +1 g +388.128 439.347 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 439.347 19.8712 0.2005 re +f* +0 g +256.256 439.547 19.2691 0.2006 re +f* +1 g +275.525 439.547 4.4158 0.2006 re +f* +0 g +279.94 439.547 12.4446 0.2006 re +f* +1 g +292.385 439.547 7.6273 0.2006 re +f* +0 g +300.012 439.547 26.495 0.2006 re +f* +1 g +326.507 439.547 27.2979 0.2006 re +f* +0.498 0 0.482 rg +353.805 439.547 9.8352 0.2006 re +f* +1 g +363.641 439.547 3.4122 0.2006 re +f* +0.498 0 0.482 rg +367.053 439.547 21.0755 0.2006 re +f* +1 g +388.128 439.547 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 439.547 19.8712 0.2006 re +f* +0 g +256.456 439.748 19.0684 0.2006 re +f* +1 g +275.525 439.748 4.6165 0.2006 re +f* +0 g +280.141 439.748 12.4446 0.2006 re +f* +1 g +292.586 439.748 7.2259 0.2006 re +f* +0 g +299.812 439.748 26.0935 0.2006 re +f* +1 g +325.905 439.748 27.6993 0.2006 re +f* +0.498 0 0.482 rg +353.605 439.748 10.2367 0.2006 re +f* +1 g +363.841 439.748 3.2115 0.2006 re +f* +0.498 0 0.482 rg +367.053 439.748 21.0755 0.2006 re +f* +1 g +388.128 439.748 3.613 0.2006 re +f* +0.498 0 0.482 rg +391.741 439.748 19.6705 0.2006 re +f* +0 g +256.456 439.948 19.269 0.2005 re +f* +1 g +275.725 439.948 4.4159 0.2005 re +f* +0 g +280.141 439.948 12.6453 0.2005 re +f* +1 g +292.786 439.948 7.0252 0.2005 re +f* +0 g +299.812 439.948 25.6921 0.2005 re +f* +1 g +325.504 439.948 27.6993 0.2005 re +f* +0.498 0 0.482 rg +353.203 439.948 10.8388 0.2005 re +f* +1 g +364.042 439.948 2.6094 0.2005 re +f* +0.498 0 0.482 rg +366.651 439.948 18.4661 0.2005 re +f* +1 g +385.117 439.948 0.2008 0.2005 re +f* +0.498 0 0.482 rg +385.318 439.948 2.81 0.2005 re +f* +1 g +388.128 439.948 3.613 0.2005 re +f* +0.498 0 0.482 rg +391.741 439.948 19.6705 0.2005 re +f* +0 g +256.657 440.149 19.2691 0.2006 re +f* +1 g +275.926 440.149 4.2151 0.2006 re +f* +0 g +280.141 440.149 12.6453 0.2006 re +f* +1 g +292.786 440.149 7.0252 0.2006 re +f* +0 g +299.812 440.149 25.2907 0.2006 re +f* +1 g +325.102 440.149 27.8999 0.2006 re +f* +0.498 0 0.482 rg +353.002 440.149 11.2403 0.2006 re +f* +1 g +364.243 440.149 2.208 0.2006 re +f* +0.498 0 0.482 rg +366.451 440.149 18.6668 0.2006 re +f* +1 g +385.117 440.149 6.6238 0.2006 re +f* +0.498 0 0.482 rg +391.741 440.149 19.4698 0.2006 re +f* +0 g +256.858 440.35 19.2691 0.2005 re +f* +1 g +276.127 440.35 4.2151 0.2005 re +f* +0 g +280.342 440.35 12.6453 0.2005 re +f* +1 g +292.987 440.35 6.8245 0.2005 re +f* +0 g +299.812 440.35 24.6885 0.2005 re +f* +1 g +324.5 440.35 28.1007 0.2005 re +f* +0.498 0 0.482 rg +352.601 440.35 12.2439 0.2005 re +f* +1 g +364.845 440.35 1.0036 0.2005 re +f* +0.498 0 0.482 rg +365.848 440.35 19.269 0.2005 re +f* +1 g +385.117 440.35 6.6238 0.2005 re +f* +0.498 0 0.482 rg +391.741 440.35 19.2691 0.2005 re +f* +0 g +256.858 440.55 19.4698 0.2006 re +f* +1 g +276.327 440.55 4.0144 0.2006 re +f* +0 g +280.342 440.55 12.6453 0.2006 re +f* +1 g +292.987 440.55 6.6238 0.2006 re +f* +0 g +299.611 440.55 24.4878 0.2006 re +f* +1 g +324.099 440.55 28.3014 0.2006 re +f* +0.498 0 0.482 rg +352.4 440.55 32.7172 0.2006 re +f* +1 g +385.117 440.55 6.6238 0.2006 re +f* +0.498 0 0.482 rg +391.741 440.55 19.2691 0.2006 re +f* +0 g +257.058 440.751 19.4698 0.2005 re +f* +1 g +276.528 440.751 4.0144 0.2005 re +f* +0 g +280.543 440.751 12.6453 0.2005 re +f* +1 g +293.188 440.751 6.423 0.2005 re +f* +0 g +299.611 440.751 24.0863 0.2005 re +f* +1 g +323.697 440.751 28.3014 0.2005 re +f* +0.498 0 0.482 rg +351.999 440.751 58.8108 0.2005 re +f* +0 g +257.259 440.951 19.4697 0.2006 re +f* +1 g +276.729 440.951 3.8138 0.2006 re +f* +0 g +280.543 440.951 12.6453 0.2006 re +f* +1 g +293.188 440.951 6.423 0.2006 re +f* +0 g +299.611 440.951 23.6849 0.2006 re +f* +1 g +323.296 440.951 28.5022 0.2006 re +f* +0.498 0 0.482 rg +351.798 440.951 58.8107 0.2006 re +f* +0 g +257.259 441.152 19.6705 0.2006 re +f* +1 g +276.93 441.152 3.8136 0.2006 re +f* +0 g +280.743 441.152 12.4447 0.2006 re +f* +1 g +293.188 441.152 6.2223 0.2006 re +f* +0 g +299.41 441.152 23.4841 0.2006 re +f* +1 g +322.894 441.152 28.5022 0.2006 re +f* +0.498 0 0.482 rg +351.397 441.152 59.0115 0.2006 re +f* +0 g +257.46 441.352 19.6705 0.2005 re +f* +1 g +277.13 441.352 3.6129 0.2005 re +f* +0 g +280.743 441.352 12.4447 0.2005 re +f* +1 g +293.188 441.352 6.2223 0.2005 re +f* +0 g +299.41 441.352 23.0827 0.2005 re +f* +1 g +322.493 441.352 28.5021 0.2005 re +f* +0.498 0 0.482 rg +350.995 441.352 59.413 0.2005 re +f* +0 g +257.661 441.553 19.6705 0.2006 re +f* +1 g +277.331 441.553 3.613 0.2006 re +f* +0 g +280.944 441.553 12.4446 0.2006 re +f* +1 g +293.389 441.553 5.8208 0.2006 re +f* +0 g +299.209 441.553 23.0828 0.2006 re +f* +1 g +322.292 441.553 28.5022 0.2006 re +f* +0.498 0 0.482 rg +350.794 441.553 59.4129 0.2006 re +f* +0 g +257.661 441.753 19.8713 0.2005 re +f* +1 g +277.532 441.753 3.4122 0.2005 re +f* +0 g +280.944 441.753 12.4446 0.2005 re +f* +1 g +293.389 441.753 5.8208 0.2005 re +f* +0 g +299.209 441.753 22.6813 0.2005 re +f* +1 g +321.891 441.753 28.5022 0.2005 re +f* +0.498 0 0.482 rg +350.393 441.753 59.6137 0.2005 re +f* +0 g +257.861 441.954 19.8712 0.2006 re +f* +1 g +277.732 441.954 3.4123 0.2006 re +f* +0 g +281.145 441.954 12.2439 0.2006 re +f* +1 g +293.389 441.954 5.6201 0.2006 re +f* +0 g +299.009 441.954 22.4806 0.2006 re +f* +1 g +321.489 441.954 28.5021 0.2006 re +f* +0.498 0 0.482 rg +349.991 441.954 60.0152 0.2006 re +f* +0 g +258.062 442.155 19.8712 0.2006 re +f* +1 g +277.933 442.155 3.4122 0.2006 re +f* +0 g +281.346 442.155 12.0432 0.2006 re +f* +1 g +293.389 442.155 5.6201 0.2006 re +f* +0 g +299.009 442.155 22.2799 0.2006 re +f* +1 g +321.289 442.155 28.1007 0.2006 re +f* +0.498 0 0.482 rg +349.389 442.155 60.4166 0.2006 re +f* +0 g +258.263 442.355 19.8712 0.2005 re +f* +1 g +278.134 442.355 3.4123 0.2005 re +f* +0 g +281.546 442.355 11.8424 0.2005 re +f* +1 g +293.389 442.355 5.4194 0.2005 re +f* +0 g +298.808 442.355 22.0791 0.2005 re +f* +1 g +320.887 442.355 28.1007 0.2005 re +f* +0.498 0 0.482 rg +348.988 442.355 60.6173 0.2005 re +f* +0 g +258.263 442.556 20.0719 0.2006 re +f* +1 g +278.335 442.556 3.2116 0.2006 re +f* +0 g +281.546 442.556 11.8424 0.2006 re +f* +1 g +293.389 442.556 5.2187 0.2006 re +f* +0 g +298.607 442.556 22.0792 0.2006 re +f* +1 g +320.687 442.556 27.6992 0.2006 re +f* +0.498 0 0.482 rg +348.386 442.556 61.0187 0.2006 re +f* +0 g +258.463 442.756 20.072 0.2005 re +f* +1 g +278.535 442.756 3.2114 0.2005 re +f* +0 g +281.747 442.756 11.6418 0.2005 re +f* +1 g +293.389 442.756 5.2187 0.2005 re +f* +0 g +298.607 442.756 21.6777 0.2005 re +f* +1 g +320.285 442.756 27.6992 0.2005 re +f* +0.498 0 0.482 rg +347.984 442.756 61.4202 0.2005 re +f* +0 g +258.664 442.957 20.0719 0.2006 re +f* +1 g +278.736 442.957 3.2116 0.2006 re +f* +0 g +281.948 442.957 11.441 0.2006 re +f* +1 g +293.389 442.957 5.018 0.2006 re +f* +0 g +298.407 442.957 21.6777 0.2006 re +f* +1 g +320.084 442.957 27.2978 0.2006 re +f* +0.498 0 0.482 rg +347.382 442.957 61.8216 0.2006 re +f* +0 g +258.865 443.157 20.2727 0.2006 re +f* +1 g +279.138 443.157 3.0108 0.2006 re +f* +0 g +282.148 443.157 11.2403 0.2006 re +f* +1 g +293.389 443.157 4.8173 0.2006 re +f* +0 g +298.206 443.157 21.6776 0.2006 re +f* +1 g +319.884 443.157 26.8965 0.2006 re +f* +0.498 0 0.482 rg +346.78 443.157 62.223 0.2006 re +f* +0 g +258.865 443.358 20.4734 0.2005 re +f* +1 g +279.338 443.358 3.0108 0.2005 re +f* +0 g +282.349 443.358 11.0396 0.2005 re +f* +1 g +293.389 443.358 4.6165 0.2005 re +f* +0 g +298.005 443.358 21.477 0.2005 re +f* +1 g +319.482 443.358 26.6957 0.2005 re +f* +0.498 0 0.482 rg +346.178 443.358 62.6245 0.2005 re +f* +0 g +259.066 443.558 20.4734 0.2006 re +f* +1 g +279.539 443.558 3.0108 0.2006 re +f* +0 g +282.55 443.558 10.8388 0.2006 re +f* +1 g +293.389 443.558 4.4158 0.2006 re +f* +0 g +297.805 443.558 21.477 0.2006 re +f* +1 g +319.281 443.558 26.2942 0.2006 re +f* +0.498 0 0.482 rg +345.576 443.558 63.2267 0.2006 re +f* +0 g +259.266 443.759 20.4733 0.2005 re +f* +1 g +279.74 443.759 3.0108 0.2005 re +f* +0 g +282.75 443.759 10.4375 0.2005 re +f* +1 g +293.188 443.759 4.4158 0.2005 re +f* +0 g +297.604 443.759 21.4769 0.2005 re +f* +1 g +319.081 443.759 25.8928 0.2005 re +f* +0.498 0 0.482 rg +344.973 443.759 63.6281 0.2005 re +f* +0 g +259.467 443.959 20.6741 0.2006 re +f* +1 g +280.141 443.959 2.8101 0.2006 re +f* +0 g +282.951 443.959 10.2367 0.2006 re +f* +1 g +293.188 443.959 4.2151 0.2006 re +f* +0 g +297.403 443.959 21.4769 0.2006 re +f* +1 g +318.88 443.959 25.6921 0.2006 re +f* +0.498 0 0.482 rg +344.572 443.959 63.8288 0.2006 re +f* +0 g +259.668 444.16 20.6741 0.2006 re +f* +1 g +280.342 444.16 2.8101 0.2006 re +f* +0 g +283.152 444.16 9.8352 0.2006 re +f* +1 g +292.987 444.16 4.2152 0.2006 re +f* +0 g +297.202 444.16 21.477 0.2006 re +f* +1 g +318.679 444.16 25.2905 0.2006 re +f* +0.498 0 0.482 rg +343.97 444.16 64.2303 0.2006 re +f* +0 g +259.868 444.361 20.8748 0.2005 re +f* +1 g +280.743 444.361 2.6094 0.2005 re +f* +0 g +283.353 444.361 9.6345 0.2005 re +f* +1 g +292.987 444.361 4.0144 0.2005 re +f* +0 g +297.002 444.361 21.477 0.2005 re +f* +1 g +318.479 444.361 24.8892 0.2005 re +f* +0.498 0 0.482 rg +343.368 444.361 64.6317 0.2005 re +f* +0 g +259.868 444.561 21.0756 0.2005 re +f* +1 g +280.944 444.561 2.81 0.2005 re +f* +0 g +283.754 444.561 9.0324 0.2005 re +f* +1 g +292.786 444.561 4.0144 0.2005 re +f* +0 g +296.801 444.561 21.477 0.2005 re +f* +1 g +318.278 444.561 24.287 0.2005 re +f* +0.498 0 0.482 rg +342.565 444.561 65.2339 0.2005 re +f* +0 g +260.069 444.762 21.2762 0.2006 re +f* +1 g +281.346 444.762 2.6094 0.2006 re +f* +0 g +283.955 444.762 8.6309 0.2006 re +f* +1 g +292.586 444.762 4.0144 0.2006 re +f* +0 g +296.6 444.762 21.4769 0.2006 re +f* +1 g +318.077 444.762 23.8857 0.2006 re +f* +0.498 0 0.482 rg +341.963 444.762 65.836 0.2006 re +f* +0 g +260.27 444.962 21.2763 0.2006 re +f* +1 g +281.546 444.962 2.81 0.2006 re +f* +0 g +284.356 444.962 8.0288 0.2006 re +f* +1 g +292.385 444.962 3.8137 0.2006 re +f* +0 g +296.199 444.962 21.6776 0.2006 re +f* +1 g +317.876 444.962 23.4842 0.2006 re +f* +0.498 0 0.482 rg +341.361 444.962 66.2374 0.2006 re +f* +0 g +260.471 445.163 21.477 0.2006 re +f* +1 g +281.948 445.163 2.6094 0.2006 re +f* +0 g +284.557 445.163 7.6273 0.2006 re +f* +1 g +292.184 445.163 3.8136 0.2006 re +f* +0 g +295.998 445.163 21.6778 0.2006 re +f* +1 g +317.676 445.163 23.0827 0.2006 re +f* +0.498 0 0.482 rg +340.758 445.163 66.6388 0.2006 re +f* +0 g +260.671 445.363 21.6777 0.2005 re +f* +1 g +282.349 445.363 2.8101 0.2005 re +f* +0 g +285.159 445.363 6.6237 0.2005 re +f* +1 g +291.783 445.363 3.8137 0.2005 re +f* +0 g +295.597 445.363 21.8784 0.2005 re +f* +1 g +317.475 445.363 22.6813 0.2005 re +f* +0.498 0 0.482 rg +340.156 445.363 67.0403 0.2005 re +f* +0 g +260.872 445.564 21.8784 0.2006 re +f* +1 g +282.75 445.564 2.8101 0.2006 re +f* +0 g +285.561 445.564 5.6202 0.2006 re +f* +1 g +291.181 445.564 4.0144 0.2006 re +f* +0 g +295.195 445.564 22.0791 0.2006 re +f* +1 g +317.274 445.564 22.2799 0.2006 re +f* +0.498 0 0.482 rg +339.554 445.564 67.4417 0.2006 re +f* +0 g +261.073 445.765 22.0792 0.2005 re +f* +1 g +283.152 445.765 3.0108 0.2005 re +f* +0 g +286.163 445.765 4.2151 0.2005 re +f* +1 g +290.378 445.765 4.4158 0.2005 re +f* +0 g +294.794 445.765 22.2799 0.2005 re +f* +1 g +317.074 445.765 21.8784 0.2005 re +f* +0.498 0 0.482 rg +338.952 445.765 67.8432 0.2005 re +f* +0 g +261.073 445.965 22.4807 0.2006 re +f* +1 g +283.553 445.965 3.6129 0.2006 re +f* +0 g +287.166 445.965 2.2079 0.2006 re +f* +1 g +289.374 445.965 5.018 0.2006 re +f* +0 g +294.392 445.965 22.4805 0.2006 re +f* +1 g +316.873 445.965 21.477 0.2006 re +f* +0.498 0 0.482 rg +338.35 445.965 68.2446 0.2006 re +f* +0 g +261.274 446.166 22.882 0.2006 re +f* +1 g +284.156 446.166 9.8352 0.2006 re +f* +0 g +293.991 446.166 22.6813 0.2006 re +f* +1 g +316.672 446.166 21.0756 0.2006 re +f* +0.498 0 0.482 rg +337.748 446.166 68.646 0.2006 re +f* +0 g +261.474 446.366 23.2834 0.2005 re +f* +1 g +284.758 446.366 8.631 0.2005 re +f* +0 g +293.389 446.366 23.2834 0.2005 re +f* +1 g +316.672 446.366 20.4734 0.2005 re +f* +0.498 0 0.482 rg +337.146 446.366 69.0475 0.2005 re +f* +0 g +261.675 446.567 23.6849 0.2005 re +f* +1 g +285.36 446.567 7.4266 0.2005 re +f* +0 g +292.786 446.567 23.6849 0.2005 re +f* +1 g +316.471 446.567 19.8713 0.2005 re +f* +0.498 0 0.482 rg +336.343 446.567 69.8503 0.2005 re +f* +0 g +261.876 446.767 24.2871 0.2006 re +f* +1 g +286.163 446.767 5.6201 0.2006 re +f* +0 g +291.783 446.767 24.4878 0.2006 re +f* +1 g +316.271 446.767 19.4698 0.2006 re +f* +0.498 0 0.482 rg +335.74 446.767 70.2518 0.2006 re +f* +0 g +262.076 446.968 25.2907 0.2006 re +f* +1 g +287.367 446.968 3.2115 0.2006 re +f* +0 g +290.579 446.968 25.6921 0.2006 re +f* +1 g +316.271 446.968 18.8676 0.2006 re +f* +0.498 0 0.482 rg +335.138 446.968 70.6533 0.2006 re +f* +0 g +262.277 447.168 53.7928 0.2005 re +f* +1 g +316.07 447.168 18.4662 0.2005 re +f* +0.498 0 0.482 rg +334.536 447.168 71.0547 0.2005 re +f* +0 g +262.478 447.369 53.3913 0.2006 re +f* +1 g +315.869 447.369 18.0648 0.2006 re +f* +0.498 0 0.482 rg +333.934 447.369 71.4561 0.2006 re +f* +0 g +262.679 447.57 53.1906 0.2005 re +f* +1 g +315.869 447.57 17.4626 0.2005 re +f* +0.498 0 0.482 rg +333.332 447.57 71.8576 0.2005 re +f* +0 g +262.879 447.77 52.7893 0.2006 re +f* +1 g +315.669 447.77 17.0611 0.2006 re +f* +0.498 0 0.482 rg +332.73 447.77 72.259 0.2006 re +f* +0 g +263.08 447.971 52.5886 0.2006 re +f* +1 g +315.669 447.971 16.4589 0.2006 re +f* +0.498 0 0.482 rg +332.127 447.971 72.6605 0.2006 re +f* +0 g +263.281 448.171 52.187 0.2006 re +f* +1 g +315.468 448.171 16.0576 0.2006 re +f* +0.498 0 0.482 rg +331.525 448.171 73.0618 0.2006 re +f* +0 g +263.481 448.372 51.9863 0.2005 re +f* +1 g +315.468 448.372 15.4554 0.2005 re +f* +0.498 0 0.482 rg +330.923 448.372 73.4633 0.2005 re +f* +0 g +263.682 448.572 51.5849 0.2005 re +f* +1 g +315.267 448.572 15.0539 0.2005 re +f* +0.498 0 0.482 rg +330.321 448.572 73.8648 0.2005 re +f* +0 g +263.883 448.773 51.3842 0.2006 re +f* +1 g +315.267 448.773 14.4518 0.2006 re +f* +0.498 0 0.482 rg +329.719 448.773 74.2662 0.2006 re +f* +0 g +264.084 448.973 50.9828 0.2006 re +f* +1 g +315.066 448.973 14.2511 0.2006 re +f* +0.498 0 0.482 rg +329.317 448.973 74.4669 0.2006 re +f* +0 g +264.284 449.174 50.782 0.2005 re +f* +1 g +315.066 449.174 13.6489 0.2005 re +f* +0.498 0 0.482 rg +328.715 449.174 74.8683 0.2005 re +f* +0 g +264.485 449.375 50.5813 0.2006 re +f* +1 g +315.066 449.375 13.2475 0.2006 re +f* +0.498 0 0.482 rg +328.314 449.375 75.069 0.2006 re +f* +0 g +264.686 449.575 50.1798 0.2005 re +f* +1 g +314.866 449.575 12.8461 0.2005 re +f* +0.498 0 0.482 rg +327.712 449.575 75.2698 0.2005 re +f* +0 g +264.886 449.776 49.9791 0.2006 re +f* +1 g +314.866 449.776 12.4447 0.2006 re +f* +0.498 0 0.482 rg +327.31 449.776 75.4705 0.2006 re +f* +0 g +265.288 449.976 49.5776 0.2006 re +f* +1 g +314.866 449.976 12.0432 0.2006 re +f* +0.498 0 0.482 rg +326.909 449.976 75.6712 0.2006 re +f* +0 g +265.489 450.177 49.1763 0.2005 re +f* +1 g +314.665 450.177 11.8424 0.2005 re +f* +0.498 0 0.482 rg +326.507 450.177 75.8719 0.2005 re +f* +0 g +265.689 450.377 48.9756 0.2005 re +f* +1 g +314.665 450.377 11.4409 0.2005 re +f* +0.498 0 0.482 rg +326.106 450.377 76.0727 0.2005 re +f* +0 g +265.89 450.578 48.7749 0.2006 re +f* +1 g +314.665 450.578 11.0395 0.2006 re +f* +0.498 0 0.482 rg +325.704 450.578 76.2734 0.2006 re +f* +0 g +266.091 450.778 48.3733 0.2006 re +f* +1 g +314.464 450.778 10.8389 0.2006 re +f* +0.498 0 0.482 rg +325.303 450.778 76.4741 0.2006 re +f* +0 g +266.292 450.979 48.1726 0.2006 re +f* +1 g +314.464 450.979 10.4374 0.2006 re +f* +0.498 0 0.482 rg +324.902 450.979 76.6748 0.2006 re +f* +0 g +266.492 451.18 47.9719 0.2005 re +f* +1 g +314.464 451.18 10.2367 0.2005 re +f* +0.498 0 0.482 rg +324.701 451.18 76.6748 0.2005 re +f* +0 g +266.693 451.38 47.7712 0.2005 re +f* +1 g +314.464 451.38 9.8353 0.2005 re +f* +0.498 0 0.482 rg +324.299 451.38 76.6748 0.2005 re +f* +0 g +267.094 451.581 47.169 0.2006 re +f* +1 g +314.263 451.581 9.8353 0.2006 re +f* +0.498 0 0.482 rg +324.099 451.581 76.6748 0.2006 re +f* +0 g +267.295 451.781 46.9683 0.2006 re +f* +1 g +314.263 451.781 9.4338 0.2006 re +f* +0.498 0 0.482 rg +323.697 451.781 76.8755 0.2006 re +f* +0 g +267.496 451.982 46.7676 0.2006 re +f* +1 g +314.263 451.982 9.2331 0.2006 re +f* +0.498 0 0.482 rg +323.497 451.982 76.8755 0.2006 re +f* +0 g +267.697 452.183 46.5669 0.2005 re +f* +1 g +314.263 452.183 9.0324 0.2005 re +f* +0.498 0 0.482 rg +323.296 452.183 76.6748 0.2005 re +f* +0 g +268.098 452.383 46.1654 0.2005 re +f* +1 g +314.263 452.383 8.6309 0.2005 re +f* +0.498 0 0.482 rg +322.894 452.383 76.8756 0.2005 re +f* +0 g +268.299 452.583 45.764 0.2006 re +f* +1 g +314.063 452.583 8.631 0.2006 re +f* +0.498 0 0.482 rg +322.694 452.583 76.8754 0.2006 re +f* +0 g +268.499 452.784 45.5633 0.2006 re +f* +1 g +314.063 452.784 8.4302 0.2006 re +f* +0.498 0 0.482 rg +322.493 452.784 76.8755 0.2006 re +f* +0 g +268.7 452.985 45.3626 0.2005 re +f* +1 g +314.063 452.985 8.2295 0.2005 re +f* +0.498 0 0.482 rg +322.292 452.985 76.6748 0.2005 re +f* +0 g +269.102 453.185 44.9612 0.2006 re +f* +1 g +314.063 453.185 8.0288 0.2006 re +f* +0.498 0 0.482 rg +322.092 453.185 76.6748 0.2006 re +f* +0 g +269.302 453.386 44.7604 0.2005 re +f* +1 g +314.063 453.386 7.828 0.2005 re +f* +0.498 0 0.482 rg +321.891 453.386 76.6748 0.2005 re +f* +0 g +269.503 453.586 44.5597 0.2006 re +f* +1 g +314.063 453.586 7.6274 0.2006 re +f* +0.498 0 0.482 rg +321.69 453.586 76.6747 0.2006 re +f* +0 g +269.904 453.787 44.1583 0.2006 re +f* +1 g +314.063 453.787 7.4266 0.2006 re +f* +0.498 0 0.482 rg +321.489 453.787 76.4741 0.2006 re +f* +0 g +270.105 453.987 43.9576 0.2005 re +f* +1 g +314.063 453.987 7.2259 0.2005 re +f* +0.498 0 0.482 rg +321.289 453.987 76.4741 0.2005 re +f* +0 g +270.306 454.188 43.7568 0.2006 re +f* +1 g +314.063 454.188 7.2259 0.2006 re +f* +0.498 0 0.482 rg +321.289 454.188 76.2734 0.2006 re +f* +0 g +270.707 454.389 43.3554 0.2005 re +f* +1 g +314.063 454.389 7.0252 0.2005 re +f* +0.498 0 0.482 rg +321.088 454.389 76.0726 0.2005 re +f* +0 g +270.908 454.589 43.1547 0.2006 re +f* +1 g +314.063 454.589 6.8244 0.2006 re +f* +0.498 0 0.482 rg +320.887 454.589 76.0727 0.2006 re +f* +0 g +271.109 454.79 42.954 0.2006 re +f* +1 g +314.063 454.79 6.6238 0.2006 re +f* +0.498 0 0.482 rg +320.687 454.79 75.8719 0.2006 re +f* +0 g +271.51 454.99 42.3517 0.2005 re +f* +1 g +313.862 454.99 6.8246 0.2005 re +f* +0.498 0 0.482 rg +320.687 454.99 75.6711 0.2005 re +f* +0 g +271.711 455.191 42.151 0.2006 re +f* +1 g +313.862 455.191 6.6238 0.2006 re +f* +0.498 0 0.482 rg +320.486 455.191 75.6712 0.2006 re +f* +0 g +272.112 455.391 41.7496 0.2005 re +f* +1 g +313.862 455.391 6.4231 0.2005 re +f* +0.498 0 0.482 rg +320.285 455.391 75.4705 0.2005 re +f* +0 g +272.313 455.592 41.5488 0.2006 re +f* +1 g +313.862 455.592 6.4231 0.2006 re +f* +0.498 0 0.482 rg +320.285 455.592 75.2698 0.2006 re +f* +0 g +272.715 455.792 41.1474 0.2005 re +f* +1 g +313.862 455.792 6.2224 0.2005 re +f* +0.498 0 0.482 rg +320.084 455.792 75.069 0.2005 re +f* +0 g +272.915 455.993 41.1475 0.2006 re +f* +1 g +314.063 455.993 6.0216 0.2006 re +f* +0.498 0 0.482 rg +320.084 455.993 74.8683 0.2006 re +f* +0 g +273.116 456.194 40.9468 0.2006 re +f* +1 g +314.063 456.194 5.8208 0.2006 re +f* +0.498 0 0.482 rg +319.884 456.194 74.6677 0.2006 re +f* +0 g +273.517 456.394 40.5453 0.2005 re +f* +1 g +314.063 456.394 5.8208 0.2005 re +f* +0.498 0 0.482 rg +319.884 456.394 74.4669 0.2005 re +f* +0 g +273.919 456.595 40.1439 0.2006 re +f* +1 g +314.063 456.595 5.6202 0.2006 re +f* +0.498 0 0.482 rg +319.683 456.595 74.2661 0.2006 re +f* +0 g +274.12 456.795 39.9432 0.2005 re +f* +1 g +314.063 456.795 5.6202 0.2005 re +f* +0.498 0 0.482 rg +319.683 456.795 32.5165 0.2005 re +f* +1 g +352.2 456.795 1.0036 0.2005 re +f* +0.498 0 0.482 rg +353.203 456.795 40.5453 0.2005 re +f* +0 g +274.521 456.996 39.5417 0.2006 re +f* +1 g +314.063 456.996 5.4194 0.2006 re +f* +0.498 0 0.482 rg +319.482 456.996 32.7173 0.2006 re +f* +1 g +352.2 456.996 1.0036 0.2006 re +f* +0.498 0 0.482 rg +353.203 456.996 40.1439 0.2006 re +f* +0 g +274.722 457.196 39.3411 0.2006 re +f* +1 g +314.063 457.196 5.4194 0.2006 re +f* +0.498 0 0.482 rg +319.482 457.196 32.7173 0.2006 re +f* +1 g +352.2 457.196 1.0036 0.2006 re +f* +0.498 0 0.482 rg +353.203 457.196 39.9431 0.2006 re +f* +0 g +275.123 457.397 38.9396 0.2005 re +f* +1 g +314.063 457.397 5.4194 0.2005 re +f* +0.498 0 0.482 rg +319.482 457.397 32.7173 0.2005 re +f* +1 g +352.2 457.397 1.0036 0.2005 re +f* +0.498 0 0.482 rg +353.203 457.397 39.5417 0.2005 re +f* +0 g +275.324 457.597 38.7389 0.2006 re +f* +1 g +314.063 457.597 5.2187 0.2006 re +f* +0.498 0 0.482 rg +319.281 457.597 32.918 0.2006 re +f* +1 g +352.2 457.597 1.0036 0.2006 re +f* +0.498 0 0.482 rg +353.203 457.597 39.1403 0.2006 re +f* +0 g +275.725 457.798 38.3375 0.2005 re +f* +1 g +314.063 457.798 5.2187 0.2005 re +f* +0.498 0 0.482 rg +319.281 457.798 32.7172 0.2005 re +f* +1 g +351.999 457.798 1.2044 0.2005 re +f* +0.498 0 0.482 rg +353.203 457.798 38.9395 0.2005 re +f* +0 g +276.127 457.999 37.936 0.2006 re +f* +1 g +314.063 457.999 5.2187 0.2006 re +f* +0.498 0 0.482 rg +319.281 457.999 32.7172 0.2006 re +f* +1 g +351.999 457.999 1.2044 0.2006 re +f* +0.498 0 0.482 rg +353.203 457.999 38.5381 0.2006 re +f* +0 g +276.327 458.199 37.7353 0.2006 re +f* +1 g +314.063 458.199 5.0179 0.2006 re +f* +0.498 0 0.482 rg +319.081 458.199 32.918 0.2006 re +f* +1 g +351.999 458.199 1.2044 0.2006 re +f* +0.498 0 0.482 rg +353.203 458.199 38.1367 0.2006 re +f* +0 g +276.729 458.4 37.3339 0.2005 re +f* +1 g +314.063 458.4 5.0179 0.2005 re +f* +0.498 0 0.482 rg +319.081 458.4 32.918 0.2005 re +f* +1 g +351.999 458.4 1.2044 0.2005 re +f* +0.498 0 0.482 rg +353.203 458.4 37.9359 0.2005 re +f* +0 g +277.13 458.6 37.1331 0.2006 re +f* +1 g +314.263 458.6 4.8172 0.2006 re +f* +0.498 0 0.482 rg +319.081 458.6 32.7174 0.2006 re +f* +1 g +351.798 458.6 1.405 0.2006 re +f* +0.498 0 0.482 rg +353.203 458.6 37.5345 0.2006 re +f* +0 g +277.532 458.801 36.7316 0.2005 re +f* +1 g +314.263 458.801 4.8172 0.2005 re +f* +0.498 0 0.482 rg +319.081 458.801 32.7174 0.2005 re +f* +1 g +351.798 458.801 1.405 0.2005 re +f* +0.498 0 0.482 rg +353.203 458.801 37.1331 0.2005 re +f* +0 g +277.732 459.001 36.531 0.2006 re +f* +1 g +314.263 459.001 4.8172 0.2006 re +f* +0.498 0 0.482 rg +319.081 459.001 32.7174 0.2006 re +f* +1 g +351.798 459.001 1.405 0.2006 re +f* +0.498 0 0.482 rg +353.203 459.001 36.9323 0.2006 re +f* +0 g +278.134 459.202 36.1295 0.2006 re +f* +1 g +314.263 459.202 4.8172 0.2006 re +f* +0.498 0 0.482 rg +319.081 459.202 32.7174 0.2006 re +f* +1 g +351.798 459.202 1.405 0.2006 re +f* +0.498 0 0.482 rg +353.203 459.202 36.5309 0.2006 re +f* +0 g +278.535 459.403 35.728 0.2005 re +f* +1 g +314.263 459.403 4.6165 0.2005 re +f* +0.498 0 0.482 rg +318.88 459.403 32.7173 0.2005 re +f* +1 g +351.597 459.403 1.6058 0.2005 re +f* +0.498 0 0.482 rg +353.203 459.403 36.1295 0.2005 re +f* +0 g +278.736 459.603 35.5274 0.2005 re +f* +1 g +314.263 459.603 4.6165 0.2005 re +f* +0.498 0 0.482 rg +318.88 459.603 32.7173 0.2005 re +f* +1 g +351.597 459.603 1.6058 0.2005 re +f* +0.498 0 0.482 rg +353.203 459.603 35.7281 0.2005 re +f* +0 g +279.138 459.804 35.3266 0.2006 re +f* +1 g +314.464 459.804 4.4158 0.2006 re +f* +0.498 0 0.482 rg +318.88 459.804 32.7173 0.2006 re +f* +1 g +351.597 459.804 1.6058 0.2006 re +f* +0.498 0 0.482 rg +353.203 459.804 35.3266 0.2006 re +f* +0 g +279.539 460.004 34.9251 0.2006 re +f* +1 g +314.464 460.004 4.4158 0.2006 re +f* +0.498 0 0.482 rg +318.88 460.004 32.7173 0.2006 re +f* +1 g +351.597 460.004 1.6058 0.2006 re +f* +0.498 0 0.482 rg +353.203 460.004 34.9251 0.2006 re +f* +0 g +279.94 460.205 34.5237 0.2006 re +f* +1 g +314.464 460.205 4.4158 0.2006 re +f* +0.498 0 0.482 rg +318.88 460.205 32.5166 0.2006 re +f* +1 g +351.397 460.205 1.8065 0.2006 re +f* +0.498 0 0.482 rg +353.203 460.205 34.7245 0.2006 re +f* +0 g +280.342 460.405 34.1223 0.2005 re +f* +1 g +314.464 460.405 4.4158 0.2005 re +f* +0.498 0 0.482 rg +318.88 460.405 32.5166 0.2005 re +f* +1 g +351.397 460.405 1.8065 0.2005 re +f* +0.498 0 0.482 rg +353.203 460.405 34.323 0.2005 re +f* +0 g +280.743 460.606 33.9217 0.2006 re +f* +1 g +314.665 460.606 4.215 0.2006 re +f* +0.498 0 0.482 rg +318.88 460.606 32.5166 0.2006 re +f* +1 g +351.397 460.606 1.8065 0.2006 re +f* +0.498 0 0.482 rg +353.203 460.606 33.9215 0.2006 re +f* +0 g +281.145 460.806 33.5202 0.2005 re +f* +1 g +314.665 460.806 4.215 0.2005 re +f* +0.498 0 0.482 rg +318.88 460.806 32.3159 0.2005 re +f* +1 g +351.196 460.806 2.0072 0.2005 re +f* +0.498 0 0.482 rg +353.203 460.806 33.5201 0.2005 re +f* +0 g +281.546 461.007 33.1187 0.2006 re +f* +1 g +314.665 461.007 4.215 0.2006 re +f* +0.498 0 0.482 rg +318.88 461.007 32.3159 0.2006 re +f* +1 g +351.196 461.007 2.0072 0.2006 re +f* +0.498 0 0.482 rg +353.203 461.007 33.1186 0.2006 re +f* +0 g +281.948 461.208 32.7173 0.2006 re +f* +1 g +314.665 461.208 4.215 0.2006 re +f* +0.498 0 0.482 rg +318.88 461.208 32.3159 0.2006 re +f* +1 g +351.196 461.208 2.0072 0.2006 re +f* +0.498 0 0.482 rg +353.203 461.208 32.7172 0.2006 re +f* +0 g +282.349 461.408 32.3159 0.2005 re +f* +1 g +314.665 461.408 4.215 0.2005 re +f* +0.498 0 0.482 rg +318.88 461.408 32.1151 0.2005 re +f* +1 g +350.995 461.408 2.208 0.2005 re +f* +0.498 0 0.482 rg +353.203 461.408 32.3158 0.2005 re +f* +0 g +282.75 461.609 32.1151 0.2005 re +f* +1 g +314.866 461.609 4.0144 0.2005 re +f* +0.498 0 0.482 rg +318.88 461.609 32.1151 0.2005 re +f* +1 g +350.995 461.609 2.208 0.2005 re +f* +0.498 0 0.482 rg +353.203 461.609 31.9143 0.2005 re +f* +0 g +283.152 461.809 31.7136 0.2006 re +f* +1 g +314.866 461.809 4.0144 0.2006 re +f* +0.498 0 0.482 rg +318.88 461.809 32.1151 0.2006 re +f* +1 g +350.995 461.809 2.208 0.2006 re +f* +0.498 0 0.482 rg +353.203 461.809 31.5129 0.2006 re +f* +0 g +283.553 462.01 31.3121 0.2006 re +f* +1 g +314.866 462.01 4.0144 0.2006 re +f* +0.498 0 0.482 rg +318.88 462.01 31.9145 0.2006 re +f* +1 g +350.794 462.01 2.4086 0.2006 re +f* +0.498 0 0.482 rg +353.203 462.01 31.1115 0.2006 re +f* +0 g +283.955 462.21 31.1115 0.2005 re +f* +1 g +315.066 462.21 3.8136 0.2005 re +f* +0.498 0 0.482 rg +318.88 462.21 31.9145 0.2005 re +f* +1 g +350.794 462.21 2.4086 0.2005 re +f* +0.498 0 0.482 rg +353.203 462.21 30.7101 0.2005 re +f* +0 g +284.356 462.411 30.7101 0.2006 re +f* +1 g +315.066 462.411 3.8136 0.2006 re +f* +0.498 0 0.482 rg +318.88 462.411 31.9145 0.2006 re +f* +1 g +350.794 462.411 2.4086 0.2006 re +f* +0.498 0 0.482 rg +353.203 462.411 30.1079 0.2006 re +f* +0 g +284.758 462.611 30.5094 0.2005 re +f* +1 g +315.267 462.611 3.6129 0.2005 re +f* +0.498 0 0.482 rg +318.88 462.611 31.7137 0.2005 re +f* +1 g +350.594 462.611 2.6094 0.2005 re +f* +0.498 0 0.482 rg +353.203 462.611 29.7065 0.2005 re +f* +0 g +285.36 462.812 29.9072 0.2006 re +f* +1 g +315.267 462.812 3.6129 0.2006 re +f* +0.498 0 0.482 rg +318.88 462.812 31.7137 0.2006 re +f* +1 g +350.594 462.812 2.6094 0.2006 re +f* +0.498 0 0.482 rg +353.203 462.812 29.305 0.2006 re +f* +0 g +285.761 463.013 29.5058 0.2006 re +f* +1 g +315.267 463.013 3.6129 0.2006 re +f* +0.498 0 0.482 rg +318.88 463.013 31.7137 0.2006 re +f* +1 g +350.594 463.013 2.6094 0.2006 re +f* +0.498 0 0.482 rg +353.203 463.013 28.9035 0.2006 re +f* +0 g +286.163 463.213 29.305 0.2006 re +f* +1 g +315.468 463.213 3.4122 0.2006 re +f* +0.498 0 0.482 rg +318.88 463.213 31.513 0.2006 re +f* +1 g +350.393 463.213 2.8101 0.2006 re +f* +0.498 0 0.482 rg +353.203 463.213 28.5021 0.2006 re +f* +0 g +286.564 463.414 28.9036 0.2005 re +f* +1 g +315.468 463.414 3.6129 0.2005 re +f* +0.498 0 0.482 rg +319.081 463.414 31.3123 0.2005 re +f* +1 g +350.393 463.414 2.8101 0.2005 re +f* +0.498 0 0.482 rg +353.203 463.414 27.9 0.2005 re +f* +0 g +287.166 463.614 28.3014 0.2005 re +f* +1 g +315.468 463.614 3.6129 0.2005 re +f* +0.498 0 0.482 rg +319.081 463.614 31.1116 0.2005 re +f* +1 g +350.192 463.614 3.0108 0.2005 re +f* +0.498 0 0.482 rg +353.203 463.614 27.4985 0.2005 re +f* +0 g +287.568 463.815 28.1008 0.2006 re +f* +1 g +315.669 463.815 3.4121 0.2006 re +f* +0.498 0 0.482 rg +319.081 463.815 31.1116 0.2006 re +f* +1 g +350.192 463.815 3.0108 0.2006 re +f* +0.498 0 0.482 rg +353.203 463.815 27.0971 0.2006 re +f* +0 g +287.969 464.015 27.6994 0.2006 re +f* +1 g +315.669 464.015 3.4121 0.2006 re +f* +0.498 0 0.482 rg +319.081 464.015 30.9108 0.2006 re +f* +1 g +349.991 464.015 3.2116 0.2006 re +f* +0.498 0 0.482 rg +353.203 464.015 26.495 0.2006 re +f* +0 g +288.571 464.216 27.2978 0.2005 re +f* +1 g +315.869 464.216 3.2115 0.2005 re +f* +0.498 0 0.482 rg +319.081 464.216 30.9108 0.2005 re +f* +1 g +349.991 464.216 3.2116 0.2005 re +f* +0.498 0 0.482 rg +353.203 464.216 26.0935 0.2005 re +f* +0 g +288.973 464.416 26.8964 0.2006 re +f* +1 g +315.869 464.416 3.2115 0.2006 re +f* +0.498 0 0.482 rg +319.081 464.416 30.7102 0.2006 re +f* +1 g +349.791 464.416 3.4122 0.2006 re +f* +0.498 0 0.482 rg +353.203 464.416 25.4914 0.2006 re +f* +0 g +289.575 464.617 26.495 0.2005 re +f* +1 g +316.07 464.617 3.2115 0.2005 re +f* +0.498 0 0.482 rg +319.281 464.617 30.5094 0.2005 re +f* +1 g +349.791 464.617 3.4122 0.2005 re +f* +0.498 0 0.482 rg +353.203 464.617 25.0899 0.2005 re +f* +0 g +289.976 464.818 26.0936 0.2006 re +f* +1 g +316.07 464.818 3.2115 0.2006 re +f* +0.498 0 0.482 rg +319.281 464.818 30.3086 0.2006 re +f* +1 g +349.59 464.818 3.613 0.2006 re +f* +0.498 0 0.482 rg +353.203 464.818 24.4878 0.2006 re +f* +0 g +290.579 465.018 25.6921 0.2006 re +f* +1 g +316.271 465.018 3.0108 0.2006 re +f* +0.498 0 0.482 rg +319.281 465.018 30.3086 0.2006 re +f* +1 g +349.59 465.018 3.613 0.2006 re +f* +0.498 0 0.482 rg +353.203 465.018 24.0863 0.2006 re +f* +0 g +291.181 465.219 25.0899 0.2005 re +f* +1 g +316.271 465.219 3.0108 0.2005 re +f* +0.498 0 0.482 rg +319.281 465.219 30.1079 0.2005 re +f* +1 g +349.389 465.219 3.8137 0.2005 re +f* +0.498 0 0.482 rg +353.203 465.219 23.4842 0.2005 re +f* +0 g +291.582 465.419 24.8892 0.2005 re +f* +1 g +316.471 465.419 3.0108 0.2005 re +f* +0.498 0 0.482 rg +319.482 465.419 29.9072 0.2005 re +f* +1 g +349.389 465.419 3.8137 0.2005 re +f* +0.498 0 0.482 rg +353.203 465.419 22.882 0.2005 re +f* +0 g +292.184 465.62 24.287 0.2006 re +f* +1 g +316.471 465.62 3.0108 0.2006 re +f* +0.498 0 0.482 rg +319.482 465.62 29.7065 0.2006 re +f* +1 g +349.189 465.62 4.0144 0.2006 re +f* +0.498 0 0.482 rg +353.203 465.62 22.4806 0.2006 re +f* +0 g +292.786 465.82 23.8856 0.2006 re +f* +1 g +316.672 465.82 2.8101 0.2006 re +f* +0.498 0 0.482 rg +319.482 465.82 29.7065 0.2006 re +f* +1 g +349.189 465.82 4.0144 0.2006 re +f* +0.498 0 0.482 rg +353.203 465.82 21.8784 0.2006 re +f* +0 g +293.389 466.021 23.2834 0.2006 re +f* +1 g +316.672 466.021 3.0109 0.2006 re +f* +0.498 0 0.482 rg +319.683 466.021 29.3049 0.2006 re +f* +1 g +348.988 466.021 4.2152 0.2006 re +f* +0.498 0 0.482 rg +353.203 466.021 21.2762 0.2006 re +f* +0 g +293.79 466.222 23.0827 0.2005 re +f* +1 g +316.873 466.222 2.8102 0.2005 re +f* +0.498 0 0.482 rg +319.683 466.222 29.3049 0.2005 re +f* +1 g +348.988 466.222 4.2152 0.2005 re +f* +0.498 0 0.482 rg +353.203 466.222 20.6741 0.2005 re +f* +0 g +294.392 466.422 22.6813 0.2006 re +f* +1 g +317.074 466.422 2.6094 0.2006 re +f* +0.498 0 0.482 rg +319.683 466.422 29.1043 0.2006 re +f* +1 g +348.787 466.422 4.4158 0.2006 re +f* +0.498 0 0.482 rg +353.203 466.422 20.0719 0.2006 re +f* +0 g +295.195 466.623 21.8784 0.2005 re +f* +1 g +317.074 466.623 2.81 0.2005 re +f* +0.498 0 0.482 rg +319.884 466.623 28.7029 0.2005 re +f* +1 g +348.586 466.623 4.6166 0.2005 re +f* +0.498 0 0.482 rg +353.203 466.623 19.4698 0.2005 re +f* +0 g +295.797 466.823 21.477 0.2006 re +f* +1 g +317.274 466.823 2.6093 0.2006 re +f* +0.498 0 0.482 rg +319.884 466.823 28.7029 0.2006 re +f* +1 g +348.586 466.823 4.6166 0.2006 re +f* +0.498 0 0.482 rg +353.203 466.823 18.8676 0.2006 re +f* +0 g +296.399 467.024 20.8748 0.2006 re +f* +1 g +317.274 467.024 2.8101 0.2006 re +f* +0.498 0 0.482 rg +320.084 467.024 28.3014 0.2006 re +f* +1 g +348.386 467.024 4.8173 0.2006 re +f* +0.498 0 0.482 rg +353.203 467.024 18.2654 0.2006 re +f* +0 g +297.002 467.224 20.4734 0.2005 re +f* +1 g +317.475 467.224 2.6094 0.2005 re +f* +0.498 0 0.482 rg +320.084 467.224 28.1007 0.2005 re +f* +1 g +348.185 467.224 5.018 0.2005 re +f* +0.498 0 0.482 rg +353.203 467.224 17.6633 0.2005 re +f* +0 g +297.604 467.425 20.072 0.2005 re +f* +1 g +317.676 467.425 2.6093 0.2005 re +f* +0.498 0 0.482 rg +320.285 467.425 27.9 0.2005 re +f* +1 g +348.185 467.425 5.018 0.2005 re +f* +0.498 0 0.482 rg +353.203 467.425 17.0611 0.2005 re +f* +0 g +298.206 467.625 19.6704 0.2006 re +f* +1 g +317.876 467.625 2.4087 0.2006 re +f* +0.498 0 0.482 rg +320.285 467.625 27.6992 0.2006 re +f* +1 g +347.984 467.625 5.2188 0.2006 re +f* +0.498 0 0.482 rg +353.203 467.625 16.2582 0.2006 re +f* +0 g +299.009 467.826 18.8676 0.2006 re +f* +1 g +317.876 467.826 2.6094 0.2006 re +f* +0.498 0 0.482 rg +320.486 467.826 27.2979 0.2006 re +f* +1 g +347.784 467.826 5.4194 0.2006 re +f* +0.498 0 0.482 rg +353.203 467.826 15.6561 0.2006 re +f* +0 g +299.611 468.027 18.4661 0.2005 re +f* +1 g +318.077 468.027 2.6095 0.2005 re +f* +0.498 0 0.482 rg +320.687 468.027 26.8963 0.2005 re +f* +1 g +347.583 468.027 5.6202 0.2005 re +f* +0.498 0 0.482 rg +353.203 468.027 14.8532 0.2005 re +f* +0 g +300.414 468.227 17.864 0.2006 re +f* +1 g +318.278 468.227 2.4087 0.2006 re +f* +0.498 0 0.482 rg +320.687 468.227 26.8963 0.2006 re +f* +1 g +347.583 468.227 5.6202 0.2006 re +f* +0.498 0 0.482 rg +353.203 468.227 14.2511 0.2006 re +f* +0 g +301.217 468.428 17.2619 0.2005 re +f* +1 g +318.479 468.428 2.4086 0.2005 re +f* +0.498 0 0.482 rg +320.887 468.428 26.495 0.2005 re +f* +1 g +347.382 468.428 5.8209 0.2005 re +f* +0.498 0 0.482 rg +353.203 468.428 13.4482 0.2005 re +f* +0 g +301.819 468.628 16.6597 0.2006 re +f* +1 g +318.479 468.628 2.6094 0.2006 re +f* +0.498 0 0.482 rg +321.088 468.628 26.0935 0.2006 re +f* +1 g +347.181 468.628 6.0216 0.2006 re +f* +0.498 0 0.482 rg +353.203 468.628 12.6453 0.2006 re +f* +0 g +302.622 468.829 16.0576 0.2006 re +f* +1 g +318.679 468.829 2.4086 0.2006 re +f* +0.498 0 0.482 rg +321.088 468.829 25.8927 0.2006 re +f* +1 g +346.981 468.829 6.2224 0.2006 re +f* +0.498 0 0.482 rg +353.203 468.829 11.8424 0.2006 re +f* +0 g +303.425 469.029 15.4553 0.2005 re +f* +1 g +318.88 469.029 2.4087 0.2005 re +f* +0.498 0 0.482 rg +321.289 469.029 25.4914 0.2005 re +f* +1 g +346.78 469.029 6.423 0.2005 re +f* +0.498 0 0.482 rg +353.203 469.029 11.2403 0.2005 re +f* +0 g +304.227 469.23 14.8532 0.2006 re +f* +1 g +319.081 469.23 2.4087 0.2006 re +f* +0.498 0 0.482 rg +321.489 469.23 25.0899 0.2006 re +f* +1 g +346.579 469.23 6.6238 0.2006 re +f* +0.498 0 0.482 rg +353.203 469.23 10.4374 0.2006 re +f* +0 g +305.231 469.43 14.0504 0.2005 re +f* +1 g +319.281 469.43 2.4087 0.2005 re +f* +0.498 0 0.482 rg +321.69 469.43 24.8891 0.2005 re +f* +1 g +346.579 469.43 6.6238 0.2005 re +f* +0.498 0 0.482 rg +353.203 469.43 9.4338 0.2005 re +f* +0 g +306.034 469.631 13.4482 0.2006 re +f* +1 g +319.482 469.631 2.4086 0.2006 re +f* +0.498 0 0.482 rg +321.891 469.631 24.4878 0.2006 re +f* +1 g +346.379 469.631 6.8245 0.2006 re +f* +0.498 0 0.482 rg +353.203 469.631 8.6309 0.2006 re +f* +0 g +306.837 469.832 12.8461 0.2006 re +f* +1 g +319.683 469.832 2.4086 0.2006 re +f* +0.498 0 0.482 rg +322.092 469.832 24.0863 0.2006 re +f* +1 g +346.178 469.832 7.0252 0.2006 re +f* +0.498 0 0.482 rg +353.203 469.832 7.6273 0.2006 re +f* +0 g +307.841 470.032 12.0431 0.2005 re +f* +1 g +319.884 470.032 2.4087 0.2005 re +f* +0.498 0 0.482 rg +322.292 470.032 23.6848 0.2005 re +f* +1 g +345.977 470.032 7.226 0.2005 re +f* +0.498 0 0.482 rg +353.203 470.032 6.8244 0.2005 re +f* +0 g +308.844 470.233 11.2403 0.2006 re +f* +1 g +320.084 470.233 2.4086 0.2006 re +f* +0.498 0 0.482 rg +322.493 470.233 23.2835 0.2006 re +f* +1 g +345.776 470.233 7.4266 0.2006 re +f* +0.498 0 0.482 rg +353.203 470.233 5.6201 0.2006 re +f* +0 g +309.848 470.433 10.4374 0.2005 re +f* +1 g +320.285 470.433 2.4087 0.2005 re +f* +0.498 0 0.482 rg +322.694 470.433 22.6812 0.2005 re +f* +1 g +345.375 470.433 7.8281 0.2005 re +f* +0.498 0 0.482 rg +353.203 470.433 4.6165 0.2005 re +f* +0 g +311.052 470.634 9.4338 0.2006 re +f* +1 g +320.486 470.634 2.4086 0.2006 re +f* +0.498 0 0.482 rg +322.894 470.634 22.2799 0.2006 re +f* +1 g +345.174 470.634 8.0288 0.2006 re +f* +0.498 0 0.482 rg +353.203 470.634 3.6129 0.2006 re +f* +0 g +312.256 470.834 8.4303 0.2005 re +f* +1 g +320.687 470.834 2.4086 0.2005 re +f* +0.498 0 0.482 rg +323.095 470.834 21.8783 0.2005 re +f* +1 g +344.973 470.834 8.2296 0.2005 re +f* +0.498 0 0.482 rg +353.203 470.834 2.4086 0.2005 re +f* +0 g +313.461 471.035 7.6274 0.2006 re +f* +1 g +321.088 471.035 2.2079 0.2006 re +f* +0.498 0 0.482 rg +323.296 471.035 21.477 0.2006 re +f* +1 g +344.773 471.035 8.4302 0.2006 re +f* +0.498 0 0.482 rg +353.203 471.035 1.2043 0.2006 re +f* +0 g +314.665 471.235 6.6237 0.2006 re +f* +1 g +321.289 471.235 2.4086 0.2006 re +f* +0.498 0 0.482 rg +323.697 471.235 20.8748 0.2006 re +f* +0 g +316.271 471.436 5.2187 0.2005 re +f* +1 g +321.489 471.436 2.4086 0.2005 re +f* +0.498 0 0.482 rg +323.898 471.436 20.2727 0.2005 re +f* +0 g +317.676 471.637 4.215 0.2006 re +f* +1 g +321.891 471.637 2.208 0.2006 re +f* +0.498 0 0.482 rg +324.099 471.637 19.8711 0.2006 re +f* +0 g +319.482 471.837 2.6094 0.2006 re +f* +1 g +322.092 471.837 2.4086 0.2006 re +f* +0.498 0 0.482 rg +324.5 471.837 19.0683 0.2006 re +f* +0 g +321.289 472.038 0.8029 0.2005 re +f* +1 g +322.092 472.038 2.6093 0.2005 re +f* +0.498 0 0.482 rg +324.701 472.038 18.6669 0.2005 re +f* +0.498 0 0.482 rg +325.102 472.238 17.864 0.2006 re +f* +0.498 0 0.482 rg +325.504 472.439 17.2619 0.2005 re +f* +0.498 0 0.482 rg +325.905 472.639 16.459 0.2006 re +f* +0.498 0 0.482 rg +326.307 472.84 15.6561 0.2006 re +f* +0.498 0 0.482 rg +326.909 473.041 14.6526 0.2005 re +f* +0.498 0 0.482 rg +327.511 473.241 13.4482 0.2006 re +f* +0.498 0 0.482 rg +328.113 473.442 12.4447 0.2005 re +f* +0.498 0 0.482 rg +328.715 473.642 11.2403 0.2006 re +f* +0.498 0 0.482 rg +329.518 473.843 9.8352 0.2005 re +f* +0.498 0 0.482 rg +330.321 474.043 8.2296 0.2006 re +f* +0.498 0 0.482 rg +331.525 474.244 6.0216 0.2006 re +f* +0.498 0 0.482 rg +333.533 474.445 2.2079 0.2005 re +f* +Q +showpage +pdfEndPage +end +%%Trailer +cleartomark +countdictstack +exch sub { end } repeat +restore +%%EOF +grestore diff --git a/conf/logo.png b/conf/logo.png new file mode 100644 index 000000000..1e415e6d8 Binary files /dev/null and b/conf/logo.png differ diff --git a/conf/lpr b/conf/lpr new file mode 100644 index 000000000..fa1c31315 --- /dev/null +++ b/conf/lpr @@ -0,0 +1 @@ +lpr -h diff --git a/conf/maxsearchrecordsperpage b/conf/maxsearchrecordsperpage new file mode 100644 index 000000000..29d6383b5 --- /dev/null +++ b/conf/maxsearchrecordsperpage @@ -0,0 +1 @@ +100 diff --git a/conf/payment_receipt_email b/conf/payment_receipt_email new file mode 100644 index 000000000..1a0a75830 --- /dev/null +++ b/conf/payment_receipt_email @@ -0,0 +1,26 @@ + +{ $date } + +Dear { $name }, + +This message is to inform you that your payment of ${ $paid } has been +received. + +Payment ID: { $paynum } +Date: { $date } +Amount: { $paid } +Type: { $payby } # { $payinfo } + +{ + if ( $balance > 0 ) { + $OUT .= "Your current balance is now \$$balance.\n\n"; + } elsif ( $balance < 0 ) { + $OUT .= 'You have a credit balance of $'. sprintf("%.2f",0-$balance). + ".\n". + "Future charges will be deducted from this balance before billing ". + "you again.\n\n"; + + } +} +Thank you for your business. + diff --git a/conf/report_template b/conf/report_template new file mode 100644 index 000000000..9c6bb2b4a --- /dev/null +++ b/conf/report_template @@ -0,0 +1,14 @@ +{ sprintf("%-19s", "Page $page of $total_pages"); } { + my $spacer = (40 - length($title) > 0) ? 40 - length($title) : 0; + $spacer = int($spacer / 2); + my $titlelen = 40 - $spacer; + sprintf("%*s%-*s", $spacer, " ", $titlelen, $title); + } { use Date::Format; time2str("%x %X", $date); } + + +{ + join("\n", map { $_ } report_lines(57)); +} + + + diff --git a/conf/shells b/conf/shells new file mode 100644 index 000000000..a41fc6209 --- /dev/null +++ b/conf/shells @@ -0,0 +1,5 @@ + +/bin/sh +/bin/csh +/bin/bash +/bin/false diff --git a/conf/show-msgcat-codes b/conf/show-msgcat-codes new file mode 100644 index 000000000..e69de29bb diff --git a/conf/smtpmachine b/conf/smtpmachine new file mode 100644 index 000000000..2fbb50c4a --- /dev/null +++ b/conf/smtpmachine @@ -0,0 +1 @@ +localhost diff --git a/conf/soadefaultttl b/conf/soadefaultttl new file mode 100644 index 000000000..92f616fb8 --- /dev/null +++ b/conf/soadefaultttl @@ -0,0 +1 @@ +259200 diff --git a/conf/soaexpire b/conf/soaexpire new file mode 100644 index 000000000..d235b91b6 --- /dev/null +++ b/conf/soaexpire @@ -0,0 +1 @@ +3600000 diff --git a/conf/soarefresh b/conf/soarefresh new file mode 100644 index 000000000..9f35f8e81 --- /dev/null +++ b/conf/soarefresh @@ -0,0 +1 @@ +10800 diff --git a/conf/soaretry b/conf/soaretry new file mode 100644 index 000000000..bb08106db --- /dev/null +++ b/conf/soaretry @@ -0,0 +1 @@ +1800 diff --git a/conf/ticket_system b/conf/ticket_system new file mode 100644 index 000000000..631f98a94 --- /dev/null +++ b/conf/ticket_system @@ -0,0 +1 @@ +RT_Internal diff --git a/conf/welcome_letter b/conf/welcome_letter new file mode 100644 index 000000000..be7b484ca --- /dev/null +++ b/conf/welcome_letter @@ -0,0 +1,121 @@ +%% file: random_latex +%% Purpose: Multipage template for welcome letters +%% +%% Based on work by +%% +%% Mark Asplen-Taylor +%% Asplen Management Ltd +%% www.asplen.co.uk +%% +%% Kristian Hoffman +%% +%% Changes +%% 0.1 6/19/07 Created + +\documentclass[letterpaper]{article} + +\hyphenpenalty=5000 +\usepackage{fancyhdr,lastpage,ifthen,afterpage} +\usepackage{graphicx} % required for logo graphic + +\addtolength{\voffset}{-0.0cm} % top margin to top of header +\addtolength{\hoffset}{-0.6cm} % left margin on page +\addtolength{\topmargin}{-1.25cm} % top margin to top of header +\setlength{\headheight}{2.0cm} % height of header +\setlength{\headsep}{1.0cm} % between header and text +\setlength{\footskip}{1.0cm} % bottom of footer from bottom of text + +%\addtolength{\textwidth}{2.1in} % width of text +\setlength{\textwidth}{19.5cm} +\setlength{\textheight}{19.5cm} +\setlength{\oddsidemargin}{-0.9cm} % odd page left margin +\setlength{\evensidemargin}{-0.9cm} % even page left margin + +\renewcommand{\headrulewidth}{0pt} +\renewcommand{\footrulewidth}{0pt} + +% Adjust the inset of the mailing address +\newcommand{\addressinset}[1][]{\hspace{1.0cm}} + +% Adjust the inset of the return address and logo +\newcommand{\returninset}[1][]{\hspace{-0.25cm}} + +% New command for address lines i.e. skip them if blank +\newcommand{\addressline}[1]{\ifthenelse{\equal{#1}{}}{}{#1\newline}} + +% Remove plain style header/footer +\fancypagestyle{plain}{ + \fancyhead{} +} +\fancyhf{} + +% Define fancy header/footer for first and subsequent pages + +\fancyfoot[R]{ + \ifthenelse{\equal{\thepage}{1}} + { % First page + ~ + } + { % ... pages + \small{\thepage\ of \pageref{LastPage}} + } +} + +\fancyhead[L]{ + \ifthenelse{\equal{\thepage}{1}} + { % First page + \returninset + \makebox{ + \begin{tabular}{ll} + \includegraphics{[@-- $conf_dir --@]/logo.eps} & + \begin{minipage}[b]{5.5cm} +[@-- $returnaddress --@] + \end{minipage} + \end{tabular} + } + } + { % ... pages + %\includegraphics{[@-- $conf_dir --@]/logo.eps} % Uncomment if you want the logo on all pages. + } +} + +\pagestyle{fancy} + + +%% Font options are: +%% bch Bitsream Charter +%% put Utopia +%% phv Adobe Helvetica +%% pnc New Century Schoolbook +%% ptm Times +%% pcr Courier + +\renewcommand{\familydefault}{phv} + + +\begin{document} +% +\begin{tabular}{ll} +\addressinset \rule{0cm}{0cm} & +\makebox{ +\begin{minipage}[t]{5.0cm} +\vspace{0.25cm} +\textbf{[@-- $payname --@]}\\ +\addressline{[@-- $company --@]} +\addressline{[@-- $address1 --@]} +\addressline{[@-- $address2 --@]} +\addressline{[@-- $city --@], [@-- $state --@]~~[@-- $zip --@]} +\addressline{[@-- $country --@]} +\end{minipage}} +\end{tabular} +\vspace{1.5cm} +\\ +% Your content goes here +Dear [@-- $first --@] [@-- $last --@]:\\ +\\ + Thank you for choosing [@-- $company_name --@]. We aim to meet all of your + needs. Please do not hesitate to contact us for any additional + services or assistance.\\ + +\end{document} + diff --git a/debian/README.Debian b/debian/README.Debian new file mode 100644 index 000000000..b51eee8d5 --- /dev/null +++ b/debian/README.Debian @@ -0,0 +1,6 @@ +freeside for Debian +------------------- + +<possible notes regarding this package - if none, delete this file> + + -- Ivan Kohler <ivan-debian@420.am>, Thu, 12 Apr 2001 15:49:17 -0700 diff --git a/debian/changelog b/debian/changelog new file mode 100644 index 000000000..d8283b5d9 --- /dev/null +++ b/debian/changelog @@ -0,0 +1,9 @@ +freeside (1.4.1-1) unstable; urgency=low + + * Initial Release. + + -- Ivan Kohler <ivan-debian@420.am> Thu, 12 Apr 2001 15:49:17 -0700 + +Local variables: +mode: debian-changelog +End: diff --git a/debian/conffiles.ex b/debian/conffiles.ex new file mode 100644 index 000000000..8686d2af8 --- /dev/null +++ b/debian/conffiles.ex @@ -0,0 +1,7 @@ +# +# If you want to use this conffile, remove all comments and put files that +# you want dpkg to process here using their absolute pathnames. +# See section 9.1 of the packaging manual. +# +# for example: +# /etc/freeside/freeside.conf diff --git a/debian/control b/debian/control new file mode 100644 index 000000000..d7873b228 --- /dev/null +++ b/debian/control @@ -0,0 +1,59 @@ +Source: freeside +Section: admin +Priority: optional +Maintainer: Ivan Kohler <ivan-debian@420.am> +Build-Depends: debhelper (>> 3.0.0) +Standards-Version: 3.5.2 + +Package: freeside +Architecture: any +Depends: freeside-lib +Recommends: freeside-doc, freeside-ui-web +Suggests: freeside-selfservice-server +Description: Billing and administration package for ISPs. + Freeside is a billing and account administration package for ISPs. It stores + customer information in an SQL database, and will update UNIX passwd and + shadow files, RADIUS users file and SQL databases, and configuration for + sendmail, qmail, BIND and/or Apache. It is also useful as a central database + of accounts/domains/web-space for a large number of machines. + +Package: freeside-doc +Architecture: all +Description: Documentation for freeside + This package provides the HTML documentation for Freeside, a billing and + account administration package for ISPs. + +Package: freeside-lib +Architecture: all +Depends: libmime-base64-perl, libdigest-md5-perl, liburi-perl, libhtml-tagset-perl, libhtml-parser-perl, libnet-perl, liblocale-codes-perl, libnet-whois-perl, libwww-perl, libbusiness-creditcard-perl, libmailtools-perl, libtimedate-perl, libdate-manip-perl, libfile-counterfile-perl, libfreezethaw-perl, libtext-template-perl, libdbd-pg-perl, libdbix-datasource-perl, libdbix-dbschema-perl, libnet-ssh-perl, libnet-scp-perl, libapache-asp-perl, libtie-ixhash-perl, libtime-duration-perl, libhtml-widgets-selectlayers-perl, libstorable-perl, libapache-dbi-perl +Description: Freeside libraries and extension API + This package contains the libraries which implement the business logic and + backend functions of Freeside, a billing and account administration package + for ISPs. This package also contains the manual pages for the library API. + (? like a libmodule-perl package) + +Package: freeside-ui-web +Architecture: all +Depends: libhtml-mason-perl, libstring-approx-perl, freeside-lib, libapache-mod-perl|apache-perl +Suggests: libapache-mod-ssl|apache-ssl +Description: Easy-to-use web interface for Freeside + This package contains the web interface for Freeside, a billing and account + administration package for ISPs. This is what sales or support folks will + typically use to add new accounts, edit exiting accounts and so on. + +Package: freeside-selfservice-server +Architecture: all +Depends: freeside-lib, libnet-ssh-perl, ssh +Description: + This package contains the server side of the customer self-service interface. + It is installed on a private backend machine, and opens an outgoing ssh + connection to one or more public web server(s). + +Package: freeside-selfservice-client +Architecture: all +Depends: libstorable-perl, libhttp-browserdetect-perl, libbusiness-creditcard-perl, ssh +Description: + This package contains the client side of the customer self-service interface. + It is typically installed on a public webserver and interfaces with + freeside-selfservice-server installed on a private backend machine. + diff --git a/debian/copyright b/debian/copyright new file mode 100644 index 000000000..e148fcec5 --- /dev/null +++ b/debian/copyright @@ -0,0 +1,10 @@ +This package was debianized by Ivan Kohler <ivan-debian@420.am> on +Thu, 12 Apr 2001 15:49:17 -0700. + +It was downloaded from <fill in ftp site> + +Upstream Author(s): <put author(s) name and email here> + +Copyright: + +<Must follow here> diff --git a/debian/cron.d.ex b/debian/cron.d.ex new file mode 100644 index 000000000..61c074da3 --- /dev/null +++ b/debian/cron.d.ex @@ -0,0 +1,4 @@ +# +# Regular cron jobs for the freeside package +# +0 4 * * * root freeside_maintenance diff --git a/debian/dirs b/debian/dirs new file mode 100644 index 000000000..ca882bbb7 --- /dev/null +++ b/debian/dirs @@ -0,0 +1,2 @@ +usr/bin +usr/sbin diff --git a/debian/docs b/debian/docs new file mode 100644 index 000000000..16636bd92 --- /dev/null +++ b/debian/docs @@ -0,0 +1,3 @@ +INSTALL +README +TODO diff --git a/debian/ex.doc-base.package b/debian/ex.doc-base.package new file mode 100644 index 000000000..2a055d199 --- /dev/null +++ b/debian/ex.doc-base.package @@ -0,0 +1,22 @@ +Document: freeside +Title: Debian freeside Manual +Author: <insert document author here> +Abstract: This manual describes what freeside is + and how it can be used to + manage online manuals on Debian systems. +Section: unknown + +Format: debiandoc-sgml +Files: /usr/share/doc/freeside/freeside.sgml.gz + +Format: postscript +Files: /usr/share/doc/freeside/freeside.ps.gz + +Format: text +Files: /usr/share/doc/freeside/freeside.text.gz + +Format: HTML +Index: /usr/share/doc/freeside/html/index.html +Files: /usr/share/doc/freeside/html/*.html + + diff --git a/debian/freeside-doc.docs b/debian/freeside-doc.docs new file mode 100644 index 000000000..299950c58 --- /dev/null +++ b/debian/freeside-doc.docs @@ -0,0 +1,2 @@ +#DOCS# + diff --git a/debian/freeside-doc.files b/debian/freeside-doc.files new file mode 100644 index 000000000..299950c58 --- /dev/null +++ b/debian/freeside-doc.files @@ -0,0 +1,2 @@ +#DOCS# + diff --git a/debian/init.d.ex b/debian/init.d.ex new file mode 100644 index 000000000..57910493a --- /dev/null +++ b/debian/init.d.ex @@ -0,0 +1,70 @@ +#! /bin/sh +# +# skeleton example file to build /etc/init.d/ scripts. +# This file should be used to construct scripts for /etc/init.d. +# +# Written by Miquel van Smoorenburg <miquels@cistron.nl>. +# Modified for Debian GNU/Linux +# by Ian Murdock <imurdock@gnu.ai.mit.edu>. +# +# Version: @(#)skeleton 1.8 03-Mar-1998 miquels@cistron.nl +# +# This file was automatically customized by dh-make on Thu, 12 Apr 2001 15:49:17 -0700 + +PATH=/sbin:/bin:/usr/sbin:/usr/bin +DAEMON=/usr/sbin/freeside +NAME=freeside +DESC=freeside + +test -f $DAEMON || exit 0 + +set -e + +case "$1" in + start) + echo -n "Starting $DESC: " + start-stop-daemon --start --quiet --pidfile /var/run/$NAME.pid \ + --exec $DAEMON + echo "$NAME." + ;; + stop) + echo -n "Stopping $DESC: " + start-stop-daemon --stop --quiet --pidfile /var/run/$NAME.pid \ + --exec $DAEMON + echo "$NAME." + ;; + #reload) + # + # If the daemon can reload its config files on the fly + # for example by sending it SIGHUP, do it here. + # + # If the daemon responds to changes in its config file + # directly anyway, make this a do-nothing entry. + # + # echo "Reloading $DESC configuration files." + # start-stop-daemon --stop --signal 1 --quiet --pidfile \ + # /var/run/$NAME.pid --exec $DAEMON + #;; + restart|force-reload) + # + # If the "reload" option is implemented, move the "force-reload" + # option to the "reload" entry above. If not, "force-reload" is + # just the same as "restart". + # + echo -n "Restarting $DESC: " + start-stop-daemon --stop --quiet --pidfile \ + /var/run/$NAME.pid --exec $DAEMON + sleep 1 + start-stop-daemon --start --quiet --pidfile \ + /var/run/$NAME.pid --exec $DAEMON + echo "$NAME." + ;; + *) + N=/etc/init.d/$NAME + # echo "Usage: $N {start|stop|restart|reload|force-reload}" >&2 + echo "Usage: $N {start|stop|restart|force-reload}" >&2 + exit 1 + ;; +esac + +exit 0 diff --git a/debian/manpage.1.ex b/debian/manpage.1.ex new file mode 100644 index 000000000..ec542bb05 --- /dev/null +++ b/debian/manpage.1.ex @@ -0,0 +1,60 @@ +.\" Hey, EMACS: -*- nroff -*- +.\" First parameter, NAME, should be all caps +.\" Second parameter, SECTION, should be 1-8, maybe w/ subsection +.\" other parameters are allowed: see man(7), man(1) +.TH FREESIDE SECTION "April 12, 2001" +.\" Please adjust this date whenever revising the manpage. +.\" +.\" Some roff macros, for reference: +.\" .nh disable hyphenation +.\" .hy enable hyphenation +.\" .ad l left justify +.\" .ad b justify to both left and right margins +.\" .nf disable filling +.\" .fi enable filling +.\" .br insert line break +.\" .sp <n> insert n+1 empty lines +.\" for manpage-specific macros, see man(7) +.SH NAME +freeside \- program to do something +.SH SYNOPSIS +.B freeside +.RI [ options ] " files" ... +.br +.B bar +.RI [ options ] " files" ... +.SH DESCRIPTION +This manual page documents briefly the +.B freeside +and +.B bar +commands. +This manual page was written for the Debian GNU/Linux distribution +because the original program does not have a manual page. +Instead, it has documentation in the GNU Info format; see below. +.PP +.\" TeX users may be more comfortable with the \fB<whatever>\fP and +.\" \fI<whatever>\fP escape sequences to invode bold face and italics, +.\" respectively. +\fBfreeside\fP is a program that... +.SH OPTIONS +These programs follow the usual GNU command line syntax, with long +options starting with two dashes (`-'). +A summary of options is included below. +For a complete description, see the Info files. +.TP +.B \-h, \-\-help +Show summary of options. +.TP +.B \-v, \-\-version +Show version of program. +.SH SEE ALSO +.BR bar (1), +.BR baz (1). +.br +The programs are documented fully by +.IR "The Rise and Fall of a Fooish Bar" , +available via the Info system. +.SH AUTHOR +This manual page was written by Ivan Kohler <ivan-debian@420.am>, +for the Debian GNU/Linux system (but may be used by others). diff --git a/debian/manpage.sgml.ex b/debian/manpage.sgml.ex new file mode 100644 index 000000000..9bc3a8663 --- /dev/null +++ b/debian/manpage.sgml.ex @@ -0,0 +1,143 @@ +<!doctype refentry PUBLIC "-//OASIS//DTD DocBook V4.1//EN" [ + +<!-- Process this file with docbook-to-man to generate an nroff manual + page: `docbook-to-man manpage.sgml > manpage.1'. You may view + the manual page with: `docbook-to-man manpage.sgml | nroff -man | + less'. A typical entry in a Makefile or Makefile.am is: + +manpage.1: manpage.sgml + docbook-to-man $< > $@ + --> + + <!-- Fill in your name for FIRSTNAME and SURNAME. --> + <!ENTITY dhfirstname "<firstname>FIRSTNAME</firstname>"> + <!ENTITY dhsurname "<surname>SURNAME</surname>"> + <!-- Please adjust the date whenever revising the manpage. --> + <!ENTITY dhdate "<date>April 12, 2001</date>"> + <!-- SECTION should be 1-8, maybe w/ subsection other parameters are + allowed: see man(7), man(1). --> + <!ENTITY dhsection "<manvolnum>SECTION</manvolnum>"> + <!ENTITY dhemail "<email>ivan-debian@420.am</email>"> + <!ENTITY dhusername "Ivan Kohler"> + <!ENTITY dhucpackage "<refentrytitle>FREESIDE</refentrytitle>"> + <!ENTITY dhpackage "freeside"> + + <!ENTITY debian "<productname>Debian GNU/Linux</productname>"> + <!ENTITY gnu "<acronym>GNU</acronym>"> +]> + +<refentry> + <refentryinfo> + <address> + &dhemail; + </address> + <author> + &dhfirstname; + &dhsurname; + </author> + <copyright> + <year>2001</year> + <holder>&dhusername;</holder> + </copyright> + &dhdate; + </refentryinfo> + <refmeta> + &dhucpackage; + + &dhsection; + </refmeta> + <refnamediv> + <refname>&dhpackage;</refname> + + <refpurpose>program to do something</refpurpose> + </refnamediv> + <refsynopsisdiv> + <cmdsynopsis> + <command>&dhpackage;</command> + + <arg><option>-e <replaceable>this</replaceable></option></arg> + + <arg><option>--example <replaceable>that</replaceable></option></arg> + </cmdsynopsis> + </refsynopsisdiv> + <refsect1> + <title>DESCRIPTION + + This manual page documents briefly the + &dhpackage; and bar + commands. + + This manual page was written for the &debian; distribution + because the original program does not have a manual page. + Instead, it has documentation in the &gnu; + Info format; see below. + + &dhpackage; is a program that... + + + + OPTIONS + + These programs follow the usual GNU command line syntax, + with long options starting with two dashes (`-'). A summary of + options is included below. For a complete description, see the + Info files. + + + + + + + + Show summary of options. + + + + + + + + Show version of program. + + + + + + SEE ALSO + + bar (1), baz (1). + + The programs are documented fully by The Rise and + Fall of a Fooish Bar available via the + Info system. + + + AUTHOR + + This manual page was written by &dhusername; &dhemail; for + the &debian; system (but may be used by others). Permission is + granted to copy, distribute and/or modify this document under + the terms of the GNU Free Documentation + License, Version 1.1 or any later version published by the Free + Software Foundation; with no Invariant Sections, no Front-Cover + Texts and no Back-Cover Texts. + + + + + diff --git a/debian/menu.ex b/debian/menu.ex new file mode 100644 index 000000000..ddc947e9c --- /dev/null +++ b/debian/menu.ex @@ -0,0 +1,2 @@ +?package(freeside):needs=X11|text|vc|wm section=Apps/see-menu-manual\ + title="freeside" command="/usr/bin/freeside" diff --git a/debian/postinst.ex b/debian/postinst.ex new file mode 100644 index 000000000..c4d4bfba8 --- /dev/null +++ b/debian/postinst.ex @@ -0,0 +1,47 @@ +#! /bin/sh +# postinst script for freeside +# +# see: dh_installdeb(1) + +set -e + +# summary of how this script can be called: +# * `configure' +# * `abort-upgrade' +# * `abort-remove' `in-favour' +# +# * `abort-deconfigure' `in-favour' +# `removing' +# +# for details, see /usr/share/doc/packaging-manual/ +# +# quoting from the policy: +# Any necessary prompting should almost always be confined to the +# post-installation script, and should be protected with a conditional +# so that unnecessary prompting doesn't happen if a package's +# installation fails and the `postinst' is called with `abort-upgrade', +# `abort-remove' or `abort-deconfigure'. + +case "$1" in + configure) + + ;; + + abort-upgrade|abort-remove|abort-deconfigure) + + ;; + + *) + echo "postinst called with unknown argument \`$1'" >&2 + exit 0 + ;; +esac + +# dh_installdeb will replace this with shell code automatically +# generated by other debhelper scripts. + +#DEBHELPER# + +exit 0 + + diff --git a/debian/postrm.ex b/debian/postrm.ex new file mode 100644 index 000000000..bed8abd3d --- /dev/null +++ b/debian/postrm.ex @@ -0,0 +1,36 @@ +#! /bin/sh +# postrm script for freeside +# +# see: dh_installdeb(1) + +set -e + +# summary of how this script can be called: +# * `remove' +# * `purge' +# * `upgrade' +# * `failed-upgrade' +# * `abort-install' +# * `abort-install' +# * `abort-upgrade' +# * `disappear' overwrit>r> +# for details, see /usr/share/doc/packaging-manual/ + +case "$1" in + purge|remove|upgrade|failed-upgrade|abort-install|abort-upgrade|disappear) + + + ;; + + *) + echo "postrm called with unknown argument \`$1'" >&2 + exit 0 + +esac + +# dh_installdeb will replace this with shell code automatically +# generated by other debhelper scripts. + +#DEBHELPER# + + diff --git a/debian/preinst.ex b/debian/preinst.ex new file mode 100644 index 000000000..0b42bb28f --- /dev/null +++ b/debian/preinst.ex @@ -0,0 +1,42 @@ +#! /bin/sh +# preinst script for freeside +# +# see: dh_installdeb(1) + +set -e + +# summary of how this script can be called: +# * `install' +# * `install' +# * `upgrade' +# * `abort-upgrade' +# +# For details see /usr/share/doc/packaging-manual/ + +case "$1" in + install|upgrade) +# if [ "$1" = "upgrade" ] +# then +# start-stop-daemon --stop --quiet --oknodo \ +# --pidfile /var/run/freeside.pid \ +# --exec /usr/sbin/freeside 2>/dev/null || true +# fi + ;; + + abort-upgrade) + ;; + + *) + echo "preinst called with unknown argument \`$1'" >&2 + exit 0 + ;; +esac + +# dh_installdeb will replace this with shell code automatically +# generated by other debhelper scripts. + +#DEBHELPER# + +exit 0 + + diff --git a/debian/prerm.ex b/debian/prerm.ex new file mode 100644 index 000000000..ebb87c540 --- /dev/null +++ b/debian/prerm.ex @@ -0,0 +1,37 @@ +#! /bin/sh +# prerm script for freeside +# +# see: dh_installdeb(1) + +set -e + +# summary of how this script can be called: +# * `remove' +# * `upgrade' +# * `failed-upgrade' +# * `remove' `in-favour' +# * `deconfigure' `in-favour' +# `removing' +# +# for details, see /usr/share/doc/packaging-manual/ + +case "$1" in + remove|upgrade|deconfigure) +# install-info --quiet --remove /usr/info/freeside.info.gz + ;; + failed-upgrade) + ;; + *) + echo "prerm called with unknown argument \`$1'" >&2 + exit 0 + ;; +esac + +# dh_installdeb will replace this with shell code automatically +# generated by other debhelper scripts. + +#DEBHELPER# + +exit 0 + + diff --git a/debian/rules b/debian/rules new file mode 100755 index 000000000..71016c406 --- /dev/null +++ b/debian/rules @@ -0,0 +1,113 @@ +#!/usr/bin/make -f +# Sample debian/rules that uses debhelper. +# GNU copyright 1997 by Joey Hess. +# +# This version is for a hypothetical package that builds an +# architecture-dependant package, as well as an architecture-independent +# package. + +# Uncomment this to turn on verbose mode. +#export DH_VERBOSE=1 + +# This is the debhelper compatability version to use. +export DH_COMPAT=3 + +configure: configure-stamp +configure-stamp: + dh_testdir + # Add here commands to configure the package. + + + touch configure-stamp + +build: configure-stamp build-stamp +build-stamp: + dh_testdir + + # Add here commands to compile the package. + $(MAKE) + + touch build-stamp + +clean: + dh_testdir + dh_testroot + rm -f build-stamp configure-stamp + + # Add here commands to clean up after the build process. + -$(MAKE) clean + + dh_clean + +install: DH_OPTIONS= +install: build + dh_testdir + dh_testroot + dh_clean -k + dh_installdirs + + # Add here commands to install the package into debian/freeside. + $(MAKE) install DESTDIR=$(CURDIR)/debian/freeside + + dh_movefiles + +# Build architecture-independent files here. +# Pass -i to all debhelper commands in this target to reduce clutter. +binary-indep: build install + dh_testdir -i + dh_testroot -i +# dh_installdebconf -i + dh_installdocs -i + dh_installexamples -i + dh_installmenu -i +# dh_installlogrotate -i +# dh_installemacsen -i +# dh_installpam -i +# dh_installmime -i +# dh_installinit -i + dh_installcron -i +# dh_installman -i + dh_installinfo -i +# dh_undocumented -i + dh_installchangelogs -i + dh_link -i + dh_compress -i + dh_fixperms -i + dh_installdeb -i +# dh_perl -i + dh_gencontrol -i + dh_md5sums -i + dh_builddeb -i + +# Build architecture-dependent files here. +binary-arch: build install + dh_testdir -a + dh_testroot -a +# dh_installdebconf -a + dh_installdocs -a + dh_installexamples -a + dh_installmenu -a +# dh_installlogrotate -a +# dh_installemacsen -a +# dh_installpam -a +# dh_installmime -a +# dh_installinit -a + dh_installcron -a +# dh_installman -a + dh_installinfo -a +# dh_undocumented -a + dh_installchangelogs -a + dh_strip -a + dh_link -a + dh_compress -a + dh_fixperms -a +# dh_makeshlibs -a + dh_installdeb -a +# dh_perl -a + dh_shlibdeps -a + dh_gencontrol -a + dh_md5sums -a + dh_builddeb -a + +binary: binary-indep binary-arch +.PHONY: build clean binary-indep binary-arch binary install configure diff --git a/debian/watch.ex b/debian/watch.ex new file mode 100644 index 000000000..3f57ae020 --- /dev/null +++ b/debian/watch.ex @@ -0,0 +1,5 @@ +# Example watch control file for uscan +# Rename this file to "watch" and then you can run the "uscan" command +# to check for upstream updates and more. +# Site Directory Pattern Version Script +sunsite.unc.edu /pub/Linux/Incoming freeside-(.*)\.tar\.gz debian uupdate diff --git a/eg/TEMPLATE_cust_main.import b/eg/TEMPLATE_cust_main.import new file mode 100755 index 000000000..f6d88c701 --- /dev/null +++ b/eg/TEMPLATE_cust_main.import @@ -0,0 +1,196 @@ +#!/usr/bin/perl -w +# +# Template for importing legacy customer data + +use strict; +use Date::Parse; +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(fields qsearch qsearchs); +use FS::cust_main; +use FS::cust_pkg; +use FS::cust_svc; +use FS::svc_acct; +use FS::pkg_svc; + +my $user = shift or die &usage; +adminsuidsetup $user; + +# use these for the imported cust_main records (unless you have these in legacy +# data) +my($agentnum)=4; +my($refnum)=5; + +# map from legacy billing data to pkgpart, maps imported field +# LegacyBillingData to pkgpart. your names and pkgparts will be different +my(%pkgpart)=( + 'Employee' => 10, + 'Business' => 11, + 'Individual' => 12, + 'Basic PPP' => 13, + 'Slave' => 14, + 'Co-Located Server' => 15, + 'Virtual Web' => 16, + 'Perk Mail' => 17, + 'Credit Hold' => 18, +); + +my($file)="legacy_file"; + +open(CLIENT,$file) + or die "Can't open $file: $!"; + +# put a tab-separated header atop the file, or define @fields +# (use these names or change them below) +# +# for cust_main +# custnum - unique +# last - (name) +# first - (name) +# company +# address1 +# address2 +# city +# state +# zip +# country +# daytime - (phone) +# night - (phone) +# fax +# payby - CARD, BILL or COMP +# payinfo - Credit card #, P.O. # or COMP authorization +# paydate - Expiration +# tax - 'Y' for tax exempt +# for cust_pkg +# LegacyBillingData - maps via %pkgpart above to a pkgpart +# for svc_acct +# username + +my($header); +$header=; +chop $header; +my(@fields)=map { /^\s*(.*[^\s]+)\s*$/; $1 } split(/\t/,$header); +#print join("\n",@fields); + +my($error); +my($link,$line)=(0,0); +while () { + chop; + next if /^[\s\t]*$/; #skip any blank lines + + #define %svc hash for this record + my(@record)=split(/\t/); + my(%svc); + foreach (@fields) { + $svc{$_}=shift @record; + } + + # might need to massage some data like this + $svc{'payby'} =~ s/^Credit Card$/CARD/io; + $svc{'payby'} =~ s/^Check$/BILL/io; + $svc{'payby'} =~ s/^Cash$/BILL/io; + $svc{'payby'} =~ s/^$/BILL/o; + $svc{'First'} =~ s/&/and/go; + $svc{'Zip'} =~ s/\s+$//go; + + my($cust_main) = new FS::cust_main ( { + 'custnum' => $svc{'custnum'}, + 'agentnum' => $agentnum, + 'last' => $svc{'last'}, + 'first' => $svc{'first'}, + 'company' => $svc{'company'}, + 'address1' => $svc{'address1'}, + 'address2' => $svc{'address2'}, + 'city' => $svc{'city'}, + 'state' => $svc{'state'}, + 'zip' => $svc{'zip'}, + 'country' => $svc{'country'}, + 'daytime' => $svc{'daytime'}, + 'night' => $svc{'night'}, + 'fax' => $svc{'fax'}, + 'payby' => $svc{'payby'}, + 'payinfo' => $svc{'payinfo'}, + 'paydate' => $svc{'paydate'}, + 'payname' => $svc{'payname'}, + 'tax' => $svc{'tax'}, + 'refnum' => $refnum, + } ); + + $error=$cust_main->insert; + + if ( $error ) { + warn $cust_main->_dump; + warn map "$_: ". $svc{$_}. "|\n", keys %svc; + die $error; + } + + my($cust_pkg)=new FS::cust_pkg ( { + 'custnum' => $svc{'custnum'}, + 'pkgpart' => $pkgpart{$svc{'LegacyBillingData'}}, + 'setup' => '', + 'bill' => '', + 'susp' => '', + 'expire' => '', + 'cancel' => '', + } ); + + $error=$cust_pkg->insert; + if ( $error ) { + warn $svc{'LegacyBillingData'}; + die $error; + } + + unless ( $svc{'username'} ) { + warn "Empty login"; + } else { + #find svc_acct record (imported with bin/svc_acct.import) for this username + my($svc_acct)=qsearchs('svc_acct',{'username'=>$svc{'username'}}); + unless ( $svc_acct ) { + warn "username ", $svc{'username'}, " not found\n"; + } else { + #link to the cust_pkg record we created above + + #find cust_svc record for this svc_acct record + my($o_cust_svc)=qsearchs('cust_svc',{ + 'svcnum' => $svc_acct->svcnum, + 'pkgnum' => '', + } ); + unless ( $o_cust_svc ) { + warn "No unlinked cust_svc for svcnum ", $svc_acct->svcnum; + } else { + + #make sure this svcpart is in pkgpart + my($pkg_svc)=qsearchs('pkg_svc',{ + 'pkgpart' => $pkgpart{$svc{'LegacyBillingData'}}, + 'svcpart' => $o_cust_svc->svcpart, + 'quantity' => 1, + }); + unless ( $pkg_svc ) { + warn "login ", $svc{'username'}, ": No svcpart ", $o_cust_svc->svcpart, + " for pkgpart ", $pkgpart{$svc{'Acct. Type'}}, "\n" ; + } else { + + #create new cust_svc record linked to cust_pkg record + my($n_cust_svc) = new FS::cust_svc ({ + 'svcnum' => $o_cust_svc->svcnum, + 'pkgnum' => $cust_pkg->pkgnum, + 'svcpart' => $pkg_svc->svcpart, + }); + my($error) = $n_cust_svc->replace($o_cust_svc); + die $error if $error; + $link++; + } + } + } + } + + $line++; + +} + +warn "\n$link of $line lines linked\n"; + +# --- + +sub usage { + die "Usage:\n\n cust_main.import user\n"; +} diff --git a/eg/export_template.pm b/eg/export_template.pm new file mode 100644 index 000000000..2830ce337 --- /dev/null +++ b/eg/export_template.pm @@ -0,0 +1,106 @@ +package FS::part_export::myexport; + +use vars qw(@ISA %info); +use Tie::IxHash; +use FS::part_export; + +@ISA = qw(FS::part_export); + +tie my %options, 'Tie::IxHash', + 'regular_option' => { label => 'Option description', default => 'value' }, + '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.', + }, + 'checkbox_option' => { label => 'Checkbox label', type => 'checkbox' }, +; + +%info = ( + 'svc' => 'svc_acct', + #'svc' => [qw( svc_acct svc_forward )], + 'desc' => + 'Export short description', + 'options' => \%options, + 'nodomain' => 'Y', + 'notes' => <<'END' +HTML notes about this export. +END + +sub rebless { shift; } + +sub _export_insert { + my($self, $svc_something) = (shift, shift); + $err_or_queue = $self->myexport_queue( $svc_something->svcnum, 'insert', + $svc_something->username, $svc_something->_password ); + ref($err_or_queue) ? '' : $err_or_queue; +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + #return "can't change username with myexport" + # if $old->username ne $new->username; + #return '' unless $old->_password ne $new->_password; + $err_or_queue = $self->myexport_queue( $new->svcnum, + 'replace', $new->username, $new->_password ); + ref($err_or_queue) ? '' : $err_or_queue; +} + +sub _export_delete { + my( $self, $svc_something ) = (shift, shift); + $err_or_queue = $self->myexport_queue( $svc_something->svcnum, + 'delete', $svc_something->username ); + ref($err_or_queue) ? '' : $err_or_queue; +} + +#these two are optional +# fallback for svc_acct will change and restore password +sub _export_suspend { + my( $self, $svc_something ) = (shift, shift); + $err_or_queue = $self->myexport_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->myexport_queue( $svc_something->svcnum, + 'unsuspend', $svc_something->username ); + ref($err_or_queue) ? '' : $err_or_queue; +} + +### + +#a good idea to queue anything that could fail or take any time +sub myexport_queue { + my( $self, $svcnum, $method ) = (shift, shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::myexport::myexport_$method", + }; + $queue->insert( @_ ) or $queue; +} + +sub myexport_insert { #subroutine, not method + my( $username, $password ) = @_; + #do things with $username and $password +} + +sub myexport_replace { #subroutine, not method +} + +sub myexport_delete { #subroutine, not method + my( $username ) = @_; + #do things with $username +} + +sub myexport_suspend { #subroutine, not method +} + +sub myexport_unsuspend { #subroutine, not method +} + + diff --git a/eg/part_event-Action-template.pm b/eg/part_event-Action-template.pm new file mode 100644 index 000000000..c2f5ba58f --- /dev/null +++ b/eg/part_event-Action-template.pm @@ -0,0 +1,55 @@ +package FS::part_event::Action::myaction; + +use strict; + +use base qw( FS::part_event::Action ); + +# see the FS::part_event::Action manpage for full documentation on each +# of the required and optional methods. + +sub description { + 'New action (the author forgot to change this description)'; +} + +#sub eventtable_hashref { +# { 'cust_main' => 1, +# 'cust_bill' => 1, +# 'cust_pkg' => 1, +# }; +#} + +#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', +# }, +# ); +#} + +#sub default_weight { +# 100; +#} + + +sub do_action { + my( $self, $object ) = @_; + + my $cust_main = $self->cust_main($object); + + my $value_of_field = $self->option('field'); + + #do your action + + #die "Error: $error"; + return 'Null example action completed sucessfully.'; + +} + +1; diff --git a/eg/part_event-Condition-template.pm b/eg/part_event-Condition-template.pm new file mode 100644 index 000000000..cc05843b4 --- /dev/null +++ b/eg/part_event-Condition-template.pm @@ -0,0 +1,57 @@ +package FS::part_event::Condition::mycondition; + +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 { + 'New condition (the author forgot to change this description)'; +} + +#sub eventtable_hashref { +# { 'cust_main' => 1, +# 'cust_bill' => 1, +# 'cust_pkg' => 1, +# '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, $object, %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 + + #test your condition + 1; + +} + +#sub condition_sql { +# my( $class, $table ) = @_; +# #... +# 'true'; +#} + +1; diff --git a/eg/table_template-svc.pm b/eg/table_template-svc.pm new file mode 100644 index 000000000..47dcbe6e4 --- /dev/null +++ b/eg/table_template-svc.pm @@ -0,0 +1,215 @@ +package FS::svc_table; + +use strict; +use vars qw(@ISA); +#use FS::Record qw( qsearch qsearchs ); +use FS::svc_Common; +use FS::cust_svc; + +@ISA = qw(FS::svc_Common); + +=head1 NAME + +FS::table_name - Object methods for table_name records + +=head1 SYNOPSIS + + use FS::table_name; + + $record = new FS::table_name \%hash; + $record = new FS::table_name { '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::table_name object represents an example. FS::table_name inherits from +FS::svc_Common. The following fields are currently supported: + +=over 4 + +=item field - description + +=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 method. + +=cut + +sub table { 'table_name'; } + +sub table_info { + { + 'name' => 'Example', + 'name_plural' => 'Example services', #optional, + 'longname_plural' => 'Example services', #optional + 'sorts' => 'svcnum', # optional sort field (or arrayref of sort fields, main first) + 'display_weight' => 100, + 'cancel_weight' => 100, + 'fields' => { + '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 + +#or something more complicated if necessary +sub search_sql { + my($class, $string) = @_; + $class->search_sql_field('search_field', $string); +} + +=item label + +Returns a meaningful identifier for this example + +=cut + +sub label { + my $self = shift; + $self->label_field; #or something more complicated if necessary +} + +=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) 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; + 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). + +=item unsuspend + +Called by the unsuspend method of FS::cust_pkg (see L). + +=item cancel + +Called by the cancel method of FS::cust_pkg (see L). + +=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 repalce methods. + +=cut + +sub check { + my $self = shift; + + my $x = $self->setfixed; + return $x unless ref($x); + my $part_svc = $x; + + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +The author forgot to customize this manpage. + +=head1 SEE ALSO + +L, L, L, L, +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/eg/table_template.pm b/eg/table_template.pm new file mode 100644 index 000000000..5da6f3b28 --- /dev/null +++ b/eg/table_template.pm @@ -0,0 +1,118 @@ +package FS::table_name; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs ); + +@ISA = qw(FS::Record); + +=head1 NAME + +FS::table_name - Object methods for table_name records + +=head1 SYNOPSIS + + use FS::table_name; + + $record = new FS::table_name \%hash; + $record = new FS::table_name { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::table_name object represents an example. FS::table_name inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item field - description + +=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 method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'table_name'; } + +=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('primary_key') + || $self->ut_number('validate_other_fields') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +The author forgot to customize this manpage. + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/eg/xmlrpc-example.pl b/eg/xmlrpc-example.pl new file mode 100755 index 000000000..7a2a0a6f0 --- /dev/null +++ b/eg/xmlrpc-example.pl @@ -0,0 +1,23 @@ +#!/usr/bin/perl + +use strict; +use Frontier::Client; +use Data::Dumper; + +my $server = new Frontier::Client ( + url => 'http://user:pass@freesidehost/misc/xmlrpc.cgi', +); + +#my $method = 'cust_main.smart_search'; +#my @args = (search => '1'); + +my $method = 'Record.qsearch'; +my @args = (cust_main => { }); + +my $result = $server->call($method, @args); + +if (ref($result) eq 'ARRAY') { + print "Result:\n"; + print Dumper(@$result); +} + diff --git a/etc/abbr_state.txt b/etc/abbr_state.txt new file mode 100644 index 000000000..7e4f57f78 --- /dev/null +++ b/etc/abbr_state.txt @@ -0,0 +1,72 @@ +State/Possession Abbreviation + +ALABAMA AL +ALASKA AK +AMERICAN SAMOA AS +ARIZONA AZ +ARKANSAS AR +CALIFORNIA CA +COLORADO CO +CONNECTICUT CT +DELAWARE DE +DISTRICT OF COLUMBIA DC +FEDERATED STATES OF MICRONESIA FM +FLORIDA FL +GEORGIA GA +GUAM GU +HAWAII HI +IDAHO ID +ILLINOIS IL +INDIANA IN +IOWA IA +KANSAS KS +KENTUCKY KY +LOUISIANA LA +MAINE ME +MARSHALL ISLANDS MH +MARYLAND MD +MASSACHUSETTS MA +MICHIGAN MI +MINNESOTA MN +MISSISSIPPI MS +MISSOURI MO +MONTANA MT +NEBRASKA NE +NEVADA NV +NEW HAMPSHIRE NH +NEW JERSEY NJ +NEW MEXICO NM +NEW YORK NY +NORTH CAROLINA NC +NORTH DAKOTA ND +NORTHERN MARIANA ISLANDS MP +OHIO OH +OKLAHOMA OK +OREGON OR +PALAU PW +PENNSYLVANIA PA +PUERTO RICO PR +RHODE ISLAND RI +SOUTH CAROLINA SC +SOUTH DAKOTA SD +TENNESSEE TN +TEXAS TX +UTAH UT +VERMONT VT +VIRGIN ISLANDS VI +VIRGINIA VA +WASHINGTON WA +WEST VIRGINIA WV +WISCONSIN WI +WYOMING WY + + +Military "State" Abbreviation + +Armed Forces Africa AE +Armed Forces Americas AA +(except Canada) +Armed Forces Canada AE +Armed Forces Europe AE +Armed Forces Middle East AE +Armed Forces Pacific AP diff --git a/etc/countries.txt b/etc/countries.txt new file mode 100644 index 000000000..73c3975ed --- /dev/null +++ b/etc/countries.txt @@ -0,0 +1,239 @@ +AFGHANISTAN AF AFG 004 +ALBANIA AL ALB 008 +ALGERIA DZ DZA 012 +AMERICAN SAMOA AS ASM 016 +ANDORRA AD AND 020 +ANGOLA AO AGO 024 +ANGUILLA AI AIA 660 +ANTARCTICA AQ ATA 010 +ANTIGUA AND BARBUDA AG ATG 028 +ARGENTINA AR ARG 032 +ARMENIA AM ARM 051 +ARUBA AW ABW 533 +AUSTRALIA AU AUS 036 +AUSTRIA AT AUT 040 +AZERBAIJAN AZ AZE 031 +BAHAMAS BS BHS 044 +BAHRAIN BH BHR 048 +BANGLADESH BD BGD 050 +BARBADOS BB BRB 052 +BELARUS BY BLR 112 +BELGIUM BE BEL 056 +BELIZE BZ BLZ 084 +BENIN BJ BEN 204 +BERMUDA BM BMU 060 +BHUTAN BT BTN 064 +BOLIVIA BO BOL 068 +BOSNIA AND HERZEGOWINA BA BIH 070 +BOTSWANA BW BWA 072 +BOUVET ISLAND BV BVT 074 +BRAZIL BR BRA 076 +BRITISH INDIAN OCEAN TERRITORY IO IOT 086 +BRUNEI DARUSSALAM BN BRN 096 +BULGARIA BG BGR 100 +BURKINA FASO BF BFA 854 +BURUNDI BI BDI 108 +CAMBODIA KH KHM 116 +CAMEROON CM CMR 120 +CANADA CA CAN 124 +CAPE VERDE CV CPV 132 +CAYMAN ISLANDS KY CYM 136 +CENTRAL AFRICAN REPUBLIC CF CAF 140 +CHAD TD TCD 148 +CHILE CL CHL 152 +CHINA CN CHN 156 +CHRISTMAS ISLAND CX CXR 162 +COCOS (KEELING) ISLANDS CC CCK 166 +COLOMBIA CO COL 170 +COMOROS KM COM 174 +CONGO CG COG 178 +COOK ISLANDS CK COK 184 +COSTA RICA CR CRI 188 +COTE D'IVOIRE CI CIV 384 +CROATIA (local name: Hrvatska) HR HRV 191 +CUBA CU CUB 192 +CYPRUS CY CYP 196 +CZECH REPUBLIC CZ CZE 203 +DENMARK DK DNK 208 +DJIBOUTI DJ DJI 262 +DOMINICA DM DMA 212 +DOMINICAN REPUBLIC DO DOM 214 +EAST TIMOR TP TMP 626 +ECUADOR EC ECU 218 +EGYPT EG EGY 818 +EL SALVADOR SV SLV 222 +EQUATORIAL GUINEA GQ GNQ 226 +ERITREA ER ERI 232 +ESTONIA EE EST 233 +ETHIOPIA ET ETH 231 +FALKLAND ISLANDS (MALVINAS) FK FLK 238 +FAROE ISLANDS FO FRO 234 +FIJI FJ FJI 242 +FINLAND FI FIN 246 +FRANCE FR FRA 250 +FRANCE, METROPOLITAN FX FXX 249 +FRENCH GUIANA GF GUF 254 +FRENCH POLYNESIA PF PYF 258 +FRENCH SOUTHERN TERRITORIES TF ATF 260 +GABON GA GAB 266 +GAMBIA GM GMB 270 +GEORGIA GE GEO 268 +GERMANY DE DEU 276 +GHANA GH GHA 288 +GIBRALTAR GI GIB 292 +GREECE GR GRC 300 +GREENLAND GL GRL 304 +GRENADA GD GRD 308 +GUADELOUPE GP GLP 312 +GUAM GU GUM 316 +GUATEMALA GT GTM 320 +GUINEA GN GIN 324 +GUINEA-BISSAU GW GNB 624 +GUYANA GY GUY 328 +HAITI HT HTI 332 +HEARD AND MC DONALD ISLANDS HM HMD 334 +HONDURAS HN HND 340 +HONG KONG HK HKG 344 +HUNGARY HU HUN 348 +ICELAND IS ISL 352 +INDIA IN IND 356 +INDONESIA ID IDN 360 +IRAN (ISLAMIC REPUBLIC OF) IR IRN 364 +IRAQ IQ IRQ 368 +IRELAND IE IRL 372 +ISRAEL IL ISR 376 +ITALY IT ITA 380 +JAMAICA JM JAM 388 +JAPAN JP JPN 392 +JORDAN JO JOR 400 +KAZAKHSTAN KZ KAZ 398 +KENYA KE KEN 404 +KIRIBATI KI KIR 296 +KOREA, DEMOCRATIC PEOPLE'S REPUBLIC OF KP PRK 408 +KOREA, REPUBLIC OF KR KOR 410 +KUWAIT KW KWT 414 +KYRGYZSTAN KG KGZ 417 +LAO PEOPLE'S DEMOCRATIC REPUBLIC LA LAO 418 +LATVIA LV LVA 428 +LEBANON LB LBN 422 +LESOTHO LS LSO 426 +LIBERIA LR LBR 430 +LIBYAN ARAB JAMAHIRIYA LY LBY 434 +LIECHTENSTEIN LI LIE 438 +LITHUANIA LT LTU 440 +LUXEMBOURG LU LUX 442 +MACAU MO MAC 446 +MACEDONIA, THE FORMER YUGOSLAV REPUBLIC OF MK MKD 807 +MADAGASCAR MG MDG 450 +MALAWI MW MWI 454 +MALAYSIA MY MYS 458 +MALDIVES MV MDV 462 +MALI ML MLI 466 +MALTA MT MLT 470 +MARSHALL ISLANDS MH MHL 584 +MARTINIQUE MQ MTQ 474 +MAURITANIA MR MRT 478 +MAURITIUS MU MUS 480 +MAYOTTE YT MYT 175 +MEXICO MX MEX 484 +MICRONESIA, FEDERATED STATES OF FM FSM 583 +MOLDOVA, REPUBLIC OF MD MDA 498 +MONACO MC MCO 492 +MONGOLIA MN MNG 496 +MONTSERRAT MS MSR 500 +MOROCCO MA MAR 504 +MOZAMBIQUE MZ MOZ 508 +MYANMAR MM MMR 104 +NAMIBIA NA NAM 516 +NAURU NR NRU 520 +NEPAL NP NPL 524 +NETHERLANDS NL NLD 528 +NETHERLANDS ANTILLES AN ANT 530 +NEW CALEDONIA NC NCL 540 +NEW ZEALAND NZ NZL 554 +NICARAGUA NI NIC 558 +NIGER NE NER 562 +NIGERIA NG NGA 566 +NIUE NU NIU 570 +NORFOLK ISLAND NF NFK 574 +NORTHERN MARIANA ISLANDS MP MNP 580 +NORWAY NO NOR 578 +OMAN OM OMN 512 +PAKISTAN PK PAK 586 +PALAU PW PLW 585 +PANAMA PA PAN 591 +PAPUA NEW GUINEA PG PNG 598 +PARAGUAY PY PRY 600 +PERU PE PER 604 +PHILIPPINES PH PHL 608 +PITCAIRN PN PCN 612 +POLAND PL POL 616 +PORTUGAL PT PRT 620 +PUERTO RICO PR PRI 630 +QATAR QA QAT 634 +REUNION RE REU 638 +ROMANIA RO ROM 642 +RUSSIAN FEDERATION RU RUS 643 +RWANDA RW RWA 646 +SAINT KITTS AND NEVIS KN KNA 659 +SAINT LUCIA LC LCA 662 +SAINT VINCENT AND THE GRENADINES VC VCT 670 +SAMOA WS WSM 882 +SAN MARINO SM SMR 674 +SAO TOME AND PRINCIPE ST STP 678 +SAUDI ARABIA SA SAU 682 +SENEGAL SN SEN 686 +SEYCHELLES SC SYC 690 +SIERRA LEONE SL SLE 694 +SINGAPORE SG SGP 702 +SLOVAKIA (Slovak Republic) SK SVK 703 +SLOVENIA SI SVN 705 +SOLOMON ISLANDS SB SLB 090 +SOMALIA SO SOM 706 +SOUTH AFRICA ZA ZAF 710 +SOUTH GEORGIA AND THE SOUTH SANDWICH ISLANDS GS SGS 239 +SPAIN ES ESP 724 +SRI LANKA LK LKA 144 +ST. HELENA SH SHN 654 +ST. PIERRE AND MIQUELON PM SPM 666 +SUDAN SD SDN 736 +SURINAME SR SUR 740 +SVALBARD AND JAN MAYEN ISLANDS SJ SJM 744 +SWAZILAND SZ SWZ 748 +SWEDEN SE SWE 752 +SWITZERLAND CH CHE 756 +SYRIAN ARAB REPUBLIC SY SYR 760 +TAIWAN, PROVINCE OF CHINA TW TWN 158 +TAJIKISTAN TJ TJK 762 +TANZANIA, UNITED REPUBLIC OF TZ TZA 834 +THAILAND TH THA 764 +TOGO TG TGO 768 +TOKELAU TK TKL 772 +TONGA TO TON 776 +TRINIDAD AND TOBAGO TT TTO 780 +TUNISIA TN TUN 788 +TURKEY TR TUR 792 +TURKMENISTAN TM TKM 795 +TURKS AND CAICOS ISLANDS TC TCA 796 +TUVALU TV TUV 798 +UGANDA UG UGA 800 +UKRAINE UA UKR 804 +UNITED ARAB EMIRATES AE ARE 784 +UNITED KINGDOM GB GBR 826 +UNITED STATES US USA 840 +UNITED STATES MINOR OUTLYING ISLANDS UM UMI 581 +URUGUAY UY URY 858 +UZBEKISTAN UZ UZB 860 +VANUATU VU VUT 548 +VATICAN CITY STATE (HOLY SEE) VA VAT 336 +VENEZUELA VE VEN 862 +VIET NAM VN VNM 704 +VIRGIN ISLANDS (BRITISH) VG VGB 092 +VIRGIN ISLANDS (U.S.) VI VIR 850 +WALLIS AND FUTUNA ISLANDS WF WLF 876 +WESTERN SAHARA EH ESH 732 +YEMEN YE YEM 887 +YUGOSLAVIA YU YUG 891 +ZAIRE ZR ZAR 180 +ZAMBIA ZM ZMB 894 +ZIMBABWE ZW ZWE 716 diff --git a/etc/domain-template.txt b/etc/domain-template.txt new file mode 100644 index 000000000..8e4983ce2 --- /dev/null +++ b/etc/domain-template.txt @@ -0,0 +1,231 @@ +[ URL ftp://rs.internic.net/templates/domain-template.txt ] [ 03/98 ] + +******* Please DO NOT REMOVE Version Number or Sections A-Q ******** + +Domain Version Number: 4.0 + +******* Email completed agreement to hostmaster@internic.net ******* + + NETWORK SOLUTIONS, INC. + + DOMAIN NAME REGISTRATION AGREEMENT + + +A. Introduction. This domain name registration agreement +("Registration Agreement") is submitted to NETWORK SOLUTIONS, INC. +("NSI") for the purpose of applying for and registering a domain name +on the Internet. If this Registration Agreement is accepted by NSI, +and a domain name is registered in NSI's domain name database and +assigned to the Registrant, Registrant ("Registrant") agrees to be +bound by the terms of this Registration Agreement and the terms of +NSI's Domain Name Dispute Policy ("Dispute Policy") which is +incorporated herein by reference and made a part of this Registration +Agreement. This Registration Agreement shall be accepted at the +offices of NSI. + +B. Fees and Payments. + +1) Registration or renewal (re-registration) date through March 31, 1998: +Registrant agrees to pay a registration fee of One Hundred United States +Dollars (US$100) as consideration for the registration of each new domain +name or Fifty United States Dollars (US$50) to renew (re-register) an +existing registration. +2) Registration or renewal date on and after April 1, 1998: Registrant +agrees to pay a registration fee of Seventy United States Dollars (US$70) +as consideration for the registration of each new domain name or the +applicable renewal (re-registration) fee (currently Thirty-Five United +States Dollars (US$35)) at the time of renewal (re-registration). +3) Period of Service: The non-refundable fee covers a period of two (2) +years for each new registration, and one (1) year for each renewal, +and includes any permitted modification(s) to the domain name record +during the covered period. +4) Payment: Payment is due to Network Solutions within thirty (30) +days from the date of the invoice. + +C. Dispute Policy. Registrant agrees, as a condition to +submitting this Registration Agreement, and if the Registration +Agreement is accepted by NSI, that the Registrant shall be bound by +NSI's current Dispute Policy. The current version of the Dispute +Policy may be found at the InterNIC Registration Services web site: +"http://www.netsol.com/rs/dispute-policy.html". + +D. Dispute Policy Changes or Modifications. Registrant agrees +that NSI, in its sole discretion, may change or modify the Dispute +Policy, incorporated by reference herein, at any time. Registrant +agrees that Registrant's maintaining the registration of a domain name +after changes or modifications to the Dispute Policy become effective +constitutes Registrant's continued acceptance of these changes or +modifications. Registrant agrees that if Registrant considers any such +changes or modifications to be unacceptable, Registrant may request +that the domain name be deleted from the domain name database. + +E. Disputes. Registrant agrees that, if the registration of its +domain name is challenged by any third party, the Registrant will be +subject to the provisions specified in the Dispute Policy. + +F. Agents. Registrant agrees that if this Registration Agreement +is completed by an agent for the Registrant, such as an ISP or +Administrative Contact/Agent, the Registrant is nonetheless bound as a +principal by all terms and conditions herein, including the Dispute +Policy. + +G. Limitation of Liability. Registrant agrees that NSI shall have +no liability to the Registrant for any loss Registrant may incur in +connection with NSI's processing of this Registration Agreement, in +connection with NSI's processing of any authorized modification to the +domain name's record during the covered period, as a result of the +Registrant's ISP's failure to pay either the initial registration fee +or renewal fee, or as a result of the application of the provisions of +the Dispute Policy. Registrant agrees that in no event shall the +maximum liability of NSI under this Agreement for any matter exceed +Five Hundred United States Dollars (US$500). + +H. Indemnity. Registrant agrees, in the event the Registration +Agreement is accepted by NSI and a subsequent dispute arises with any +third party, to indemnify and hold NSI harmless pursuant to the terms +and conditions contained in the Dispute Policy. + +I. Breach. Registrant agrees that failure to abide by any +provision of this Registration Agreement or the Dispute Policy may be +considered by NSI to be a material breach and that NSI may provide a +written notice, describing the breach, to the Registrant. If, within +thirty (30) days of the date of mailing such notice, the Registrant +fails to provide evidence, which is reasonably satisfactory to NSI, +that it has not breached its obligations, then NSI may delete +Registrant's registration of the domain name. Any such breach by a +Registrant shall not be deemed to be excused simply because NSI did +not act earlier in response to that, or any other, breach by the +Registrant. + +J. No Guaranty. Registrant agrees that, by registration of a +domain name, such registration does not confer immunity from objection +to either the registration or use of the domain name. + +K. Warranty. Registrant warrants by submitting this Registration +Agreement that, to the best of Registrant's knowledge and belief, the +information submitted herein is true and correct, and that any future +changes to this information will be provided to NSI in a timely manner +according to the domain name modification procedures in place at that +time. Breach of this warranty will constitute a material breach. + +L. Revocation. Registrant agrees that NSI may delete a +Registrant's domain name if this Registration Agreement, or subsequent +modification(s) thereto, contains false or misleading information, or +conceals or omits any information NSI would likely consider material +to its decision to approve this Registration Agreement. + +M. Right of Refusal. NSI, in its sole discretion, reserves the +right to refuse to approve the Registration Agreement for any +Registrant. Registrant agrees that the submission of this Registration +Agreement does not obligate NSI to accept this Registration Agreement. +Registrant agrees that NSI shall not be liable for loss or damages +that may result from NSI's refusal to accept this Registration +Agreement. + +N. Severability. Registrant agrees that the terms of this +Registration Agreement are severable. If any term or provision is +declared invalid, it shall not affect the remaining terms or +provisions which shall continue to be binding. + +O. Entirety. Registrant agrees that this Registration Agreement +and the Dispute Policy is the complete and exclusive agreement between +Registrant and NSI regarding the registration of Registrant's domain +name. This Registration Agreement and the Dispute Policy supersede all +prior agreements and understandings, whether established by custom, +practice, policy, or precedent. + +P. Governing Law. Registrant agrees that this Registration +Agreement shall be governed in all respects by and construed in +accordance with the laws of the Commonwealth of Virginia, United +States of America. By submitting this Registration Agreement, +Registrant consents to the exclusive jurisdiction and venue of the +United States District Court for the Eastern District of Virginia, +Alexandria Division. If there is no jurisdiction in the United States +District Court for the Eastern District of Virginia, Alexandria +Division, then jurisdiction shall be in the Circuit Court of Fairfax +County, Fairfax, Virginia. + +Q. This is Domain Name Registration Agreement Version +Number 4.0. This Registration Agreement is only for registrations +under top-level domains: COM, ORG, NET, and EDU. By completing +and submitting this Registration Agreement for consideration and +acceptance by NSI, the Registrant agrees that he/she has read and +agrees to be bound by A through P above. + + +Authorization +0a. (N)ew (M)odify (D)elete....:###action### +0b. Auth Scheme................: +0c. Auth Info..................: + +1. Comments...................:###purpose### + +2. Complete Domain Name.......:###domain### + +Organization Using Domain Name + +3a. Organization Name..........:###company### +###LOOP### +3b. Street Address.............:###address### +###ENDLOOP### +3c. City.......................:###city### +3d. State......................:###state### +3e. Postal Code................:###zip### +3f. Country....................:###country### + +Administrative Contact +4a. NIC Handle (if known)......: +4b. (I)ndividual (R)ole........:I +4c. Name (Last, First).........:###last###, ###first### +4d. Organization Name..........:###company### +###LOOP### +4e. Street Address.............:###address### +###ENDLOOP### +4f. City.......................:###city### +4g. State......................:###state### +4h. Postal Code................:###zip### +4i. Country....................:###country### +4j. Phone Number...............:###daytime### +4k. Fax Number.................:###fax### +4l. E-Mailbox..................:###email### + +Technical Contact +5a. NIC Handle (if known)......:###tech_contact### +5b. (I)ndividual (R)ole........: +5c. Name (Last, First).........: +5d. Organization Name..........: +5e. Street Address.............: +5f. City.......................: +5g. State......................: +5h. Postal Code................: +5i. Country....................: +5j. Phone Number...............: +5k. Fax Number.................: +5l. E-Mailbox..................: + +Billing Contact +6a. NIC Handle (if known)......: +6b. (I)ndividual (R)ole........: +6c. Name (Last, First).........: +6d. Organization Name..........: +6e. Street Address.............: +6f. City.......................: +6g. State......................: +6h. Postal Code................: +6i. Country....................: +6j. Phone Number...............: +6k. Fax Number.................: +6l. E-Mailbox..................: + +Prime Name Server +7a. Primary Server Hostname....:###primary### +7b. Primary Server Netaddress..:###primary_ip### + +Secondary Name Server(s) +###LOOP### +8a. Secondary Server Hostname..:###secondary### +8b. Secondary Server Netaddress:###secondary_ip### +###ENDLOOP### + +END OF AGREEMENT + diff --git a/etc/megapop.pl b/etc/megapop.pl new file mode 100755 index 000000000..e2930fb55 --- /dev/null +++ b/etc/megapop.pl @@ -0,0 +1,114 @@ +#!/usr/bin/perl -Tw +# +# this will break when megapop changes the URL or format of their listing page. +# that's stupid. perhaps they can provide a machine-readable listing? + +use strict; +use LWP::UserAgent; +use FS::UID qw(adminsuidsetup); +use FS::svc_acct_pop; + +my $url = "http://www.megapop.com/location.htm"; + +my $user = shift or die &usage; +adminsuidsetup($user); + +my %state2usps = &state2usps; +$state2usps{'WASHINGTON STATE'} = 'WA'; #megapop's on crack +$state2usps{'CANADA'} = 'CANADA'; #freeside's on crack + +my $ua = new LWP::UserAgent; +my $request = new HTTP::Request('GET', $url); +my $response = $ua->request($request); +die $response->error_as_HTML unless $response->is_success; +my $line; +my $usps = ''; +foreach $line ( split("\n", $response->content) ) { + if ( $line =~ /\W(\w[\w\s]*\w)\s+LOCATIONS/i ) { + $usps = $state2usps{uc($1)} + or warn "warning: unknown state $1\n"; + } elsif ( $line =~ /(\d{3})\-(\d{3})\-(\d{4})\s+(\w[\w\s]*\w)/ ) { + print "$1 $2 $3 $4 $usps\n"; + my $svc_acct_pop = new FS::svc_acct_pop ( { + 'city' => $4, + 'state' => $usps, + 'ac' => $1, + 'exch' => $2, + } ); + my $error = $svc_acct_pop->insert; + die $error if $error; + } +} + +sub usage { + die "Usage:\n $0 user\n"; +} + +sub state2usps{ ( + 'ALABAMA' => 'AL', + 'ALASKA' => 'AK', + 'AMERICAN SAMOA' => 'AS', + 'ARIZONA' => 'AZ', + 'ARKANSAS' => 'AR', + 'CALIFORNIA' => 'CA', + 'COLORADO' => 'CO', + 'CONNECTICUT' => 'CT', + 'DELAWARE' => 'DE', + 'DISTRICT OF COLUMBIA' => 'DC', + 'FEDERATED STATES OF MICRONESIA' => 'FM', + 'FLORIDA' => 'FL', + 'GEORGIA' => 'GA', + 'GUAM' => 'GU', + 'HAWAII' => 'HI', + 'IDAHO' => 'ID', + 'ILLINOIS' => 'IL', + 'INDIANA' => 'IN', + 'IOWA' => 'IA', + 'KANSAS' => 'KS', + 'KENTUCKY' => 'KY', + 'LOUISIANA' => 'LA', + 'MAINE' => 'ME', + 'MARSHALL ISLANDS' => 'MH', + 'MARYLAND' => 'MD', + 'MASSACHUSETTS' => 'MA', + 'MICHIGAN' => 'MI', + 'MINNESOTA' => 'MN', + 'MISSISSIPPI' => 'MS', + 'MISSOURI' => 'MO', + 'MONTANA' => 'MT', + 'NEBRASKA' => 'NE', + 'NEVADA' => 'NV', + 'NEW HAMPSHIRE' => 'NH', + 'NEW JERSEY' => 'NJ', + 'NEW MEXICO' => 'NM', + 'NEW YORK' => 'NY', + 'NORTH CAROLINA' => 'NC', + 'NORTH DAKOTA' => 'ND', + 'NORTHERN MARIANA ISLANDS' => 'MP', + 'OHIO' => 'OH', + 'OKLAHOMA' => 'OK', + 'OREGON' => 'OR', + 'PALAU' => 'PW', + 'PENNSYLVANIA' => 'PA', + 'PUERTO RICO' => 'PR', + 'RHODE ISLAND' => 'RI', + 'SOUTH CAROLINA' => 'SC', + 'SOUTH DAKOTA' => 'SD', + 'TENNESSEE' => 'TN', + 'TEXAS' => 'TX', + 'UTAH' => 'UT', + 'VERMONT' => 'VT', + 'VIRGIN ISLANDS' => 'VI', + 'VIRGINIA' => 'VA', + 'WASHINGTON' => 'WA', + 'WEST VIRGINIA' => 'WV', + 'WISCONSIN' => 'WI', + 'WYOMING' => 'WY', + 'ARMED FORCES AFRICA' => 'AE', + 'ARMED FORCES AMERICAS' => 'AA', + 'ARMED FORCES CANADA' => 'AE', + 'ARMED FORCES EUROPE' => 'AE', + 'ARMED FORCES MIDDLE EAST' => 'AE', + 'ARMED FORCES PACIFIC' => 'AP', +) } + diff --git a/etc/sql-reserved-words.txt b/etc/sql-reserved-words.txt new file mode 100644 index 000000000..dc507cef5 --- /dev/null +++ b/etc/sql-reserved-words.txt @@ -0,0 +1,103 @@ +From http://epoch.cs.berkeley.edu:8000/sequoia/dba/montage/FAQ/SQL.html + by Jean Anderson (jta@postgres.berkeley.edu) + +What are the SQL reserved words? + +I grep'd the following list out of the sql docs available via anonymous ftp to speckle.ncsl.nist.gov:/isowg3. +SQL3 words are not set in stone, but you'd do well to avoid them. + + From sql1992.txt: + + AFTER, ALIAS, ASYNC, BEFORE, BOOLEAN, BREADTH, + COMPLETION, CALL, CYCLE, DATA, DEPTH, DICTIONARY, EACH, ELSEIF, + EQUALS, GENERAL, IF, IGNORE, LEAVE, LESS, LIMIT, LOOP, MODIFY, + NEW, NONE, OBJECT, OFF, OID, OLD, OPERATION, OPERATORS, OTHERS, + PARAMETERS, PENDANT, PREORDER, PRIVATE, PROTECTED, RECURSIVE, REF, + REFERENCING, REPLACE, RESIGNAL, RETURN, RETURNS, ROLE, ROUTINE, + ROW, SAVEPOINT, SEARCH, SENSITIVE, SEQUENCE, SIGNAL, SIMILAR, + SQLEXCEPTION, SQLWARNING, STRUCTURE, TEST, THERE, TRIGGER, TYPE, + UNDER, VARIABLE, VIRTUAL, VISIBLE, WAIT, WHILE, WITHOUT + + From sql1992.txt (Annex E): + + ABSOLUTE, ACTION, ADD, ALLOCATE, ALTER, ARE, ASSERTION, AT, BETWEEN, + BIT, BIT + +What are the SQL reserved words? + +I grep'd the following list out of the sql docs available via anonymous ftp to speckle.ncsl.nist.gov:/isowg3. +SQL3 words are not set in stone, but you'd do well to avoid them. + + From sql1992.txt: + + AFTER, ALIAS, ASYNC, BEFORE, BOOLEAN, BREADTH, + COMPLETION, CALL, CYCLE, DATA, DEPTH, DICTIONARY, EACH, ELSEIF, + EQUALS, GENERAL, IF, IGNORE, LEAVE, LESS, LIMIT, LOOP, MODIFY, + NEW, NONE, OBJECT, OFF, OID, OLD, OPERATION, OPERATORS, OTHERS, + PARAMETERS, PENDANT, PREORDER, PRIVATE, PROTECTED, RECURSIVE, REF, + REFERENCING, REPLACE, RESIGNAL, RETURN, RETURNS, ROLE, ROUTINE, + ROW, SAVEPOINT, SEARCH, SENSITIVE, SEQUENCE, SIGNAL, SIMILAR, + SQLEXCEPTION, SQLWARNING, STRUCTURE, TEST, THERE, TRIGGER, TYPE, + UNDER, VARIABLE, VIRTUAL, VISIBLE, WAIT, WHILE, WITHOUT + + From sql1992.txt (Annex E): + + ABSOLUTE, ACTION, ADD, ALLOCATE, ALTER, ARE, ASSERTION, AT, BETWEEN, + BIT, BIT + +What are the SQL reserved words? + +I grep'd the following list out of the sql docs available via anonymous ftp to speckle.ncsl.nist.gov:/isowg3. +SQL3 words are not set in stone, but you'd do well to avoid them. + + From sql1992.txt: + + AFTER, ALIAS, ASYNC, BEFORE, BOOLEAN, BREADTH, + COMPLETION, CALL, CYCLE, DATA, DEPTH, DICTIONARY, EACH, ELSEIF, + EQUALS, GENERAL, IF, IGNORE, LEAVE, LESS, LIMIT, LOOP, MODIFY, + NEW, NONE, OBJECT, OFF, OID, OLD, OPERATION, OPERATORS, OTHERS, + PARAMETERS, PENDANT, PREORDER, PRIVATE, PROTECTED, RECURSIVE, REF, + REFERENCING, REPLACE, RESIGNAL, RETURN, RETURNS, ROLE, ROUTINE, + ROW, SAVEPOINT, SEARCH, SENSITIVE, SEQUENCE, SIGNAL, SIMILAR, + SQLEXCEPTION, SQLWARNING, STRUCTURE, TEST, THERE, TRIGGER, TYPE, + UNDER, VARIABLE, VIRTUAL, VISIBLE, WAIT, WHILE, WITHOUT + + From sql1992.txt (Annex E): + + ABSOLUTE, ACTION, ADD, ALLOCATE, ALTER, ARE, ASSERTION, AT, BETWEEN, + BIT, BIT_LENGTH, BOTH, CASCADE, CASCADED, CASE, CAST, CATALOG, + CHAR_LENGTH, CHARACTER_LENGTH, COALESCE, COLLATE, COLLATION, COLUMN, + CONNECT, CONNECTION, CONSTRAINT, CONSTRAINTS, CONVERT, CORRESPONDING, + CROSS, CURRENT_DATE, CURRENT_TIME, CURRENT_TIMESTAMP, CURRENT_USER, + DATE, DAY, DEALLOCATE, DEFERRABLE, DEFERRED, DESCRIBE, DESCRIPTOR, + DIAGNOSTICS, DISCONNECT, DOMAIN, DROP, ELSE, END-EXEC, EXCEPT, + EXCEPTION, EXECUTE, EXTERNAL, EXTRACT, FALSE, FIRST, FULL, GET, + GLOBAL, HOUR, IDENTITY, IMMEDIATE, INITIALLY, INNER, INPUT, + INSENSITIVE, INTERSECT, INTERVAL, ISOLATION, JOIN, LAST, LEADING, + LEFT, LEVEL, LOCAL, LOWER, MATCH, MINUTE, MONTH, NAMES, NATIONAL, + NATURAL, NCHAR, NEXT, NO, NULLIF, OCTET_LENGTH, ONLY, OUTER, OUTPUT, + OVERLAPS, PAD, PARTIAL, POSITION, PREPARE, PRESERVE, PRIOR, READ, + RELATIVE, RESTRICT, REVOKE, RIGHT, ROWS, SCROLL, SECOND, SESSION, + SESSION_USER, SIZE, SPACE, SQLSTATE, SUBSTRING, SYSTEM_USER, + TEMPORARY, THEN, TIME, TIMESTAMP, TIMEZONE_HOUR, TIMEZONE_MINUTE, + TRAILING, TRANSACTION, TRANSLATE, TRANSLATION, TRIM, TRUE, UNKNOWN, + UPPER, USAGE, USING, VALUE, VARCHAR, VARYING, WHEN, WRITE, YEAR, ZONE + + From sql3part2.txt (Annex E) + + ACTION, ACTOR, AFTER, ALIAS, ASYNC, ATTRIBUTES, BEFORE, BOOLEAN, + BREADTH, COMPLETION, CURRENT_PATH, CYCLE, DATA, DEPTH, DESTROY, + DICTIONARY, EACH, ELEMENT, ELSEIF, EQUALS, FACTOR, GENERAL, HOLD, + IGNORE, INSTEAD, LESS, LIMIT, LIST, MODIFY, NEW, NEW_TABLE, NO, + NONE, OFF, OID, OLD, OLD_TABLE, OPERATION, OPERATOR, OPERATORS, + PARAMETERS, PATH, PENDANT, POSTFIX, PREFIX, PREORDER, PRIVATE, + PROTECTED, RECURSIVE, REFERENCING, REPLACE, ROLE, ROUTINE, ROW, + SAVEPOINT, SEARCH, SENSITIVE, SEQUENCE, SESSION, SIMILAR, SPACE, + SQLEXCEPTION, SQLWARNING, START, STATE, STRUCTURE, SYMBOL, TERM, + TEST, THERE, TRIGGER, TYPE, UNDER, VARIABLE, VIRTUAL, VISIBLE, + WAIT, WITHOUT + + sql3part4.txt (ANNEX E): + + CALL, DO, ELSEIF, EXCEPTION, IF, LEAVE, LOOP, OTHERS, RESIGNAL, + RETURN, RETURNS, SIGNAL, TUPLE, WHILE diff --git a/fs_passwd/fs_passwd b/fs_passwd/fs_passwd new file mode 100755 index 000000000..feddb462c --- /dev/null +++ b/fs_passwd/fs_passwd @@ -0,0 +1,131 @@ +#!/usr/bin/perl -Tw +# +# fs_passwd +# +# portions of this script are copied from the `passwd' script in the original +# (perl 4) camel book, now archived at +# http://www.perl.com/CPAN/scripts/nutshell/ch6/passwd +# +# ivan@sisd.com 98-mar-8 +# +# password lengths 0,255 instead of 6,8 - we'll let the server process +# check the data ivan@sisd.com 98-jul-17 +# +# updated for the exciting new world of self-service 2004-mar-10 + +use strict; +use Getopt::Std; +use FS::SelfService qw(passwd); +use vars qw($opt_f $opt_s); + +my($freeside_uid)=scalar(getpwnam('freeside')); + +$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'} = ''; + +$SIG{__DIE__}= sub { system '/bin/stty', 'echo'; }; + +die "passwd program isn't running setuid to freeside\n" if $> != $freeside_uid; + +unshift @ARGV, "-f" if $0 =~ /chfn$/; +unshift @ARGV, "-s" if $0 =~ /chsh$/; + +getopts('fs'); + +my($me)=''; +if ( $_ = shift(@ARGV) ) { + /^(\w{2,8})$/; + $me = $1; +} +die "You can't change the password for $me." if $me && $<; +$me = (getpwuid($<))[0] unless $me; + +my($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$dir,$shell)= + getpwnam $me; + +my($old_password,$new_password,$new_gecos,$new_shell); + +if ( $opt_f || $opt_s ) { + system '/bin/stty', '-echo'; + print "Password:"; + $old_password=; + system '/bin/stty', 'echo'; + chop($old_password); + #$old_password =~ /^(.{6,8})$/ or die "\nIllegal password.\n"; + $old_password =~ /^(.{0,255})$/ or die "\nIllegal password.\n"; + $old_password = $1; + + $new_password = ''; + + if ( $opt_f ) { + print "\nChanging gecos for $me.\n"; + print "Gecos [", $gcos, "]: "; + $new_gecos=; + chop($new_gecos); + $new_gecos ||= $gcos; + $new_gecos =~ /^(.{0,255})$/ or die "\nIllegal gecos.\n"; + } else { + $new_gecos = ''; + } + + if ( $opt_s ) { + print "\nChanging shell for $me.\n"; + print "Shell [", $shell, "]: "; + $new_shell=; + chop($new_shell); + $new_shell ||= $shell; + $new_shell =~ /^(.{0,255})$/ or die "\nIllegal shell.\n"; + } else { + $new_shell = ''; + } + +} else { + + print "Changing password for $me.\n"; + print "Old password:"; + system '/bin/stty', '-echo'; + $old_password=; + chop $old_password; + #$old_password =~ /^(.{6,8})$/ or die "\nIllegal password.\n"; + $old_password =~ /^(.{0,255})$/ or die "\nIllegal password.\n"; + $old_password = $1; + print "\nEnter the new password (minimum of 6, maximum of 8 characters)\n"; + print "Please use a combination of upper and lowercase letters and numbers.\n"; + print "New password:"; + $new_password=; + chop($new_password); + #$new_password =~ /^(.{6,8})$/ or die "\nIllegal password.\n"; + $new_password =~ /^(.{0,255})$/ or die "\nIllegal password.\n"; + $new_password = $1; + print "\nRe-enter new password:"; + my($check_new_password); + $check_new_password=; + chop($check_new_password); + die "\nThey don't match; try again.\n" unless $check_new_password eq $new_password; + + $new_gecos=''; + $new_shell=''; +} +print "\n"; + +system '/bin/stty', 'echo'; + +my $rv = passwd( + 'username' => $me, + 'old_password' => $old_password, + 'new_password' => $new_password, + 'new_gecos' => $new_gecos, + 'new_shell' => $new_shell, +); + +my $error = $rv->{error}; + +if ($error) { + print "\nUpdate error: $error\n"; +} else { + print "\nUpdate sucessful.\n"; +} diff --git a/fs_selfadmin/FS-MailAdminServer/MailAdminClient.pm b/fs_selfadmin/FS-MailAdminServer/MailAdminClient.pm new file mode 100755 index 000000000..d0a741049 --- /dev/null +++ b/fs_selfadmin/FS-MailAdminServer/MailAdminClient.pm @@ -0,0 +1,537 @@ +package FS::MailAdminClient; + +use strict; +use vars qw($VERSION @ISA @EXPORT_OK $fs_mailadmind_socket); +use Exporter; +use Socket; +use FileHandle; +use IO::Handle; + +$VERSION = '0.01'; + +@ISA = qw( Exporter ); +@EXPORT_OK = qw( signup_info authenticate list_packages list_mailboxes delete_mailbox password_mailbox add_mailbox list_forwards list_pkg_forwards delete_forward add_forward new_customer ); + +$fs_mailadmind_socket = "/usr/local/freeside/fs_mailadmind_socket"; + +$ENV{'PATH'} ='/usr/bin:/usr/ucb:/bin'; +$ENV{'SHELL'} = '/bin/sh'; +$ENV{'IFS'} = " \t\n"; +$ENV{'CDPATH'} = ''; +$ENV{'ENV'} = ''; +$ENV{'BASH_ENV'} = ''; + +my $freeside_uid = scalar(getpwnam('freeside')); +die "not running as the freeside user\n" if $> != $freeside_uid; + +=head1 NAME + +FS::MailAdminClient - Freeside mail administration client API + +=head1 SYNOPSIS + + use FS::MailAdminClient qw( signup_info list_mailboxes new_customer ); + + ( $locales, $packages, $pops ) = signup_info; + + ( $accounts ) = list_mailboxes; + + $error = new_customer ( { + 'first' => $first, + 'last' => $last, + 'ss' => $ss, + 'comapny' => $company, + 'address1' => $address1, + 'address2' => $address2, + 'city' => $city, + 'county' => $county, + 'state' => $state, + 'zip' => $zip, + 'country' => $country, + 'daytime' => $daytime, + 'night' => $night, + 'fax' => $fax, + 'payby' => $payby, + 'payinfo' => $payinfo, + 'paydate' => $paydate, + 'payname' => $payname, + 'invoicing_list' => $invoicing_list, + 'pkgpart' => $pkgpart, + 'username' => $username, + '_password' => $password, + 'popnum' => $popnum, + } ); + +=head1 DESCRIPTION + +This module provides an API for a remote mail administration server. + +It needs to be run as the freeside user. Because of this, the program which +calls these subroutines should be written very carefully. + +=head1 SUBROUTINES + +=over 4 + +=item signup_info + +Returns three array references of hash references. + +The first set of hash references is of allowable locales. Each hash reference +has the following keys: + taxnum + state + county + country + +The second set of hash references is of allowable packages. Each hash +reference has the following keys: + pkgpart + pkg + +The third set of hash references is of allowable POPs (Points Of Presence). +Each hash reference has the following keys: + popnum + city + state + ac + exch + +=cut + +sub signup_info { + socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; + connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!"; + print SOCK "signup_info\n"; + SOCK->flush; + + chop ( my $n_cust_main_county = ); + my @cust_main_county = map { + chop ( my $taxnum = ); + chop ( my $state = ); + chop ( my $county = ); + chop ( my $country = ); + { + 'taxnum' => $taxnum, + 'state' => $state, + 'county' => $county, + 'country' => $country, + }; + } 1 .. $n_cust_main_county; + + chop ( my $n_part_pkg = ); + my @part_pkg = map { + chop ( my $pkgpart = ); + chop ( my $pkg = ); + { + 'pkgpart' => $pkgpart, + 'pkg' => $pkg, + }; + } 1 .. $n_part_pkg; + + chop ( my $n_svc_acct_pop = ); + my @svc_acct_pop = map { + chop ( my $popnum = ); + chop ( my $city = ); + chop ( my $state = ); + chop ( my $ac = ); + chop ( my $exch = ); + chop ( my $loc = ); + { + 'popnum' => $popnum, + 'city' => $city, + 'state' => $state, + 'ac' => $ac, + 'exch' => $exch, + 'loc' => $loc, + }; + } 1 .. $n_svc_acct_pop; + + close SOCK; + + \@cust_main_county, \@part_pkg, \@svc_acct_pop; +} + +=item authenticate + +Authentictes against a service on the remote Freeside system. Requires a hash +reference as a parameter with the following keys: + authuser + _password + +Returns a scalar error message of the form "authuser OK|FAILED" or an error +message. + +=cut + +sub authenticate { + my $hashref = shift; + socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; + connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!"; + print SOCK "authenticate", "\n"; + SOCK->flush; + + print SOCK join("\n", map { $hashref->{$_} } qw( + authuser _password + ) ), "\n"; + SOCK->flush; + + chop( my $error = ); + close SOCK; + + $error; +} + +=item list_packages + +Returns one array reference of hash references. + +The set of hash references is of existing packages. Each hash reference +has the following keys: + pkgnum + domain + account + +=cut + +sub list_packages { + my $user = shift; + socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; + connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!"; + print SOCK "list_packages\n", $user, "\n"; + SOCK->flush; + + chop ( my $n_packages = ); + my @packages = map { + chop ( my $pkgnum = ); + chop ( my $domain = ); + chop ( my $account = ); + { + 'pkgnum' => $pkgnum, + 'domain' => $domain, + 'account' => $account, + }; + } 1 .. $n_packages; + + close SOCK; + + \@packages; +} + +=item list_mailboxes + +Returns one array references of hash references. + +The set of hash references is of existing accounts. Each hash reference +has the following keys: + svcnum + username + _password + +=cut + +sub list_mailboxes { + my ($user, $package) = @_; + socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; + connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!"; + print SOCK "list_mailboxes\n", $user, "\n", $package, "\n"; + SOCK->flush; + + chop ( my $n_svc_acct = ); + my @svc_acct = map { + chop ( my $svcnum = ); + chop ( my $username = ); + chop ( my $_password = ); + { + 'svcnum' => $svcnum, + 'username' => $username, + '_password' => $_password, + }; + } 1 .. $n_svc_acct; + + close SOCK; + + \@svc_acct; +} + +=item delete_mailbox + +Deletes a mailbox service from the remote Freeside system. Requires a hash +reference as a paramater with the following keys: + authuser + account + +Returns a scalar error message, or the empty string for success. + +=cut + +sub delete_mailbox { + my $hashref = shift; + socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; + connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!"; + print SOCK "delete_mailbox", "\n"; + SOCK->flush; + + print SOCK join("\n", map { $hashref->{$_} } qw( + authuser account + ) ), "\n"; + SOCK->flush; + + chop( my $error = ); + close SOCK; + + $error; +} + +=item password_mailbox + +Changes the password for a mailbox service on the remote Freeside system. + Requires a hash reference as a paramater with the following keys: + authuser + account + _password + +Returns a scalar error message, or the empty string for success. + +=cut + +sub password_mailbox { + my $hashref = shift; + socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; + connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!"; + print SOCK "password_mailbox", "\n"; + SOCK->flush; + + print SOCK join("\n", map { $hashref->{$_} } qw( + authuser account _password + ) ), "\n"; + SOCK->flush; + + chop( my $error = ); + close SOCK; + + $error; +} + +=item add_mailbox + +Creates a mailbox service on the remote Freeside system. Requires a hash +reference as a parameter with the following keys: + authuser + package + account + _password + +Returns a scalar error message, or the empty string for success. + +=cut + +sub add_mailbox { + my $hashref = shift; + socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; + connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!"; + print SOCK "add_mailbox", "\n"; + SOCK->flush; + + print SOCK join("\n", map { $hashref->{$_} } qw( + authuser package account _password + ) ), "\n"; + SOCK->flush; + + chop( my $error = ); + close SOCK; + + $error; +} + +=item list_forwards + +Returns one array references of hash references. + +The set of hash references is of existing forwards. Each hash reference +has the following keys: + svcnum + dest + +=cut + +sub list_forwards { + my ($user, $service) = @_; + socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; + connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!"; + print SOCK "list_forwards\n", $user, "\n", $service, "\n"; + SOCK->flush; + + chop ( my $n_svc_forward = ); + my @svc_forward = map { + chop ( my $svcnum = ); + chop ( my $dest = ); + { + 'svcnum' => $svcnum, + 'dest' => $dest, + }; + } 1 .. $n_svc_forward; + + close SOCK; + + \@svc_forward; +} + +=item list_pkg_forwards + +Returns one array references of hash references. + +The set of hash references is of existing forwards. Each hash reference +has the following keys: + svcnum + srcsvc + dest + +=cut + +sub list_pkg_forwards { + my ($user, $package) = @_; + socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; + connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!"; + print SOCK "list_pkg_forwards\n", $user, "\n", $package, "\n"; + SOCK->flush; + + chop ( my $n_svc_forward = ); + my @svc_forward = map { + chop ( my $svcnum = ); + chop ( my $srcsvc = ); + chop ( my $dest = ); + { + 'svcnum' => $svcnum, + 'srcsvc' => $srcsvc, + 'dest' => $dest, + }; + } 1 .. $n_svc_forward; + + close SOCK; + + \@svc_forward; +} + +=item delete_forward + +Deletes a forward service from the remote Freeside system. Requires a hash +reference as a paramater with the following keys: + authuser + svcnum + +Returns a scalar error message, or the empty string for success. + +=cut + +sub delete_forward { + my $hashref = shift; + socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; + connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!"; + print SOCK "delete_forward", "\n"; + SOCK->flush; + + print SOCK join("\n", map { $hashref->{$_} } qw( + authuser svcnum + ) ), "\n"; + SOCK->flush; + + chop( my $error = ); + close SOCK; + + $error; +} + +=item add_forward + +Creates a forward service on the remote Freeside system. Requires a hash +reference as a parameter with the following keys: + authuser + package + source + dest + +Returns a scalar error message, or the empty string for success. + +=cut + +sub add_forward { + my $hashref = shift; + socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; + connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!"; + print SOCK "add_forward", "\n"; + SOCK->flush; + + print SOCK join("\n", map { $hashref->{$_} } qw( + authuser package source dest + ) ), "\n"; + SOCK->flush; + + chop( my $error = ); + close SOCK; + + $error; +} + +=item new_customer HASHREF + +Adds a customer to the remote Freeside system. Requires a hash reference as +a paramater with the following keys: + first + last + ss + comapny + address1 + address2 + city + county + state + zip + country + daytime + night + fax + payby + payinfo + paydate + payname + invoicing_list + pkgpart + username + _password + popnum + +Returns a scalar error message, or the empty string for success. + +=cut + +sub new_customer { + my $hashref = shift; + + socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; + connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!"; + print SOCK "new_customer\n"; + + print SOCK join("\n", map { $hashref->{$_} } qw( + first last ss company address1 address2 city county state zip country + daytime night fax payby payinfo paydate payname invoicing_list + pkgpart username _password popnum + ) ), "\n"; + SOCK->flush; + + chop( my $error = ); + $error; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L + +=cut + +1; + diff --git a/fs_selfadmin/FS-MailAdminServer/cgi/mailadmin.cgi b/fs_selfadmin/FS-MailAdminServer/cgi/mailadmin.cgi new file mode 100755 index 000000000..c26c3dc42 --- /dev/null +++ b/fs_selfadmin/FS-MailAdminServer/cgi/mailadmin.cgi @@ -0,0 +1,698 @@ +#!/usr/bin/perl +######################################################################## +# # +# mailadmin.cgi NCI2000 # +# Jeff Finucane # +# 26 April 2001 # +# # +######################################################################## + +use DBI; +use strict; +use CGI; +use FS::MailAdminClient qw(authenticate list_packages list_mailboxes delete_mailbox password_mailbox add_mailbox list_forwards list_pkg_forwards delete_forward add_forward); + +my $sessionfile = '/usr/local/apache/htdocs/mailadmin/adminsess'; # session file +my $tmpdir = '/usr/local/apache/htdocs/mailadmin/tmp'; # Location to store temp files +my $cookiedomain = ".your.dom"; # domain if THIS server, should prepend with a '.' +my $cookieexpire = '+12h'; # expire the cookie session after this much idle time +my $sessexpire = 43200; # expire session after this long of no use (in seconds) + +my $body = ""; + +#### Should not have to change anything under this line #### +my $printmainpage = 1; +my $i = 0; +my $printheader = 1; +my $query = new CGI; +my $cgi = $query->url(); +my $now = getdatetime(); +my $current_package = 0; +my $current_account = 0; +my $current_domname = ""; + +# if they are trying to login we wont check the session yet +if ($query->param('login') eq '' && $query->param('action') ne 'login') { + checksession(); + printheader(); +} + +if ($query->param('login') ne '') { + + my $username = $query->param('username'); + my $password = $query->param('password'); + + if (!checkuserpass($username, $password)) { + printheader(); + error('not_admin'); + } + + my @alpha = ('A'..'Z', 'a'..'z', 0..9); + my $sessid = ''; + for (my $i = 0; $i < 10; $i++) { + $sessid .= @alpha[rand(@alpha)]; + } + + my $cookie1 = $query->cookie(-name=>'username', + -value=>$username, + -expires=>$cookieexpire, + -domain=>$cookiedomain); + + my $cookie2 = $query->cookie(-name=>'ma_sessionid', + -value=>$sessid, + -expires=>$cookieexpire, + -domain=>$cookiedomain); + + my $now = time(); + open(NEWSESS, ">>$sessionfile") || error('open'); + print NEWSESS "$username $sessid $now 0 0\n"; + close(NEWSESS); + + print $query->header(-COOKIE=>[$cookie1, $cookie2]); + + $printmainpage = 1; + +} elsif ($query->param('action') eq 'blankframe') { + + print "$body\n"; + $printmainpage = 0; + +} elsif ($query->param('action') eq 'list_packages') { + + my $username = $query->cookie(-name=>'username'); # session checked + my $list = list_packages($username); + print "$body\n"; + print "
    \n"; + print "\n"; + foreach my $package ( @{$list} ) { + print ""; + print "\n"; + print "\n"; + print ""; + } + print "

    Package Number

    Description

    $package->{'pkgnum'}

    $package->{'domain'}

    {'pkgnum'}&account=$package->{'account'}&domname=$package->{'domain'}\" target=\"rightmainframe\">select
    \n"; + print "\n"; + $printmainpage=0; + +} elsif ($query->param('action') eq 'list_mailboxes') { + + my $username = $query->cookie(-name=>'username'); # session checked + select_package($username) unless $current_package; + my $list = list_mailboxes($username, $current_package); + my $forwardlist = list_pkg_forwards($username, $current_package); + print "$body\n"; + print "
    \n"; + print "\n"; + foreach my $account ( @{$list} ) { + print ""; + print "\n"; + print "\n"; + print ""; + +# my $forwardlist = list_forwards($username, $account->{'svcnum'}); +# foreach my $forward ( @{$forwardlist} ) { +# my $label = qq!=> ! . $forward->{'dest'}; +# print "\n"; +# } + foreach my $forward ( @{$forwardlist} ) { + if ($forward->{'srcsvc'} == $account->{'svcnum'}) { + my $label = qq!=> ! . $forward->{'dest'}; + print "\n"; + } + } + + } + print "

    Username

    Password

    $account->{'username'}

    $account->{'_password'}

    {'svcnum'}&mailbox=$account->{'username'}\" target=\"rightmainframe\">change

    $label

    $label

    \n"; + print "\n"; + $printmainpage=0; + +} elsif ($query->param('action') eq 'select') { + + my $username = $query->cookie(-name=>'username'); # session checked + $current_package = $query->param('package'); + $current_account = $query->param('account'); + $current_domname = $query->param('domname'); + set_package(); + print "$body\n"; + print "\n"; + print "
    \n"; + print "

    Selected package $current_package\n"; + print "

    \n"; + print "\n"; + print "\n"; + $printmainpage=0; + +} elsif ($query->param('action') eq 'change') { + + my $username = $query->cookie(-name=>'username'); # session checked + select_package($username) unless $current_package; + my $account = $query->param('account'); + my $mailbox = $query->param('mailbox'); + my $list = list_forwards($username, $account); + print "$body\n"; + print "
    \n"; + print "
    \n"; + print "\n"; + print "\n"; + print "\n"; + foreach my $forward ( @{$list} ) { + my $label = qq!=> ! . $forward->{'dest'}; +# print "\n"; + print "\n"; + } + print "\n"; + print "

    Username

    $mailbox

    $label

    $label

    {'svcnum'}&mailbox=$mailbox&dest=$forward->{'dest'}\" target=\"rightmainframe\">remove

    Password

    \n"; + print "\n"; + print "\n"; + print "\n"; + print "
    \n"; + print "
    \n"; + print "
    \n"; + print "

    You may delete this user and all mailforwarding by pressing Delete This User.\n"; + print "

    To set or change the password for this user, type the new password in the box next to Password and press Change The Password.\n"; + print "

    If you would like to have mail destined for this user forwarded to another email address then press the Add Forwarding button.\n"; + print "\n"; + $printmainpage=0; + +} elsif ($query->param('deleteaccount') ne '') { + + my $username = $query->cookie(-name=>'username'); # session checked + select_package($username) unless $current_package; + my $account = $query->param('account'); + my $mailbox = $query->param('mailbox'); + print "$body\n"; + print "

    \n"; + print "

    Are you certain you want to delete user $mailbox?\n"; + print "

    \n"; + print "\n"; + print "\n"; + $printmainpage=0; + +} elsif ($query->param('deleteaccounty') ne '') { + + my $username = $query->cookie(-name=>'username'); # session checked + select_package($username) unless $current_package; + my $account = $query->param('account'); + + if ( my $error = delete_mailbox ( { + 'authuser' => $username, + 'account' => $account, + } ) ) { + print "$body\n"; + print "

    $error\n"; + print "\n"; + + } else { + print "$body\n"; + print "

    Deleted\n"; + print "\n"; + } + + $printmainpage=0; + +} elsif ($query->param('changepassword') ne '') { + + my $username = $query->cookie(-name=>'username'); # session checked + select_package($username) unless $current_package; + my $account = $query->param('account'); + my $_password = $query->param('_password'); + + if ( my $error = password_mailbox ( { + 'authuser' => $username, + 'account' => $account, + '_password' => $_password, + } ) ) { + print "$body\n"; + print "

    $error\n"; + print "\n"; + + } else { + print "$body\n"; + print "

    Changed\n"; + print "\n"; + } + + $printmainpage=0; + +} elsif ($query->param('action') eq 'newmailbox') { + + my $username = $query->cookie(-name=>'username'); # session checked + select_package($username) unless $current_package; + print "$body\n"; + print "\n"; + print "

    \n"; + print "\n"; + print "\n"; + print "

    Username

    @ " . $current_domname . "

    Password

    \n"; + print "\n"; + print "
    \n"; + print "
    \n"; + print "
    \n"; + print "

    Use this screen to add a new mailbox user. If the domain name of the email address (the part after the @ sign) is not what you expect then you may need to use List Packages to select the package with the correct domain.\n"; + print "

    Enter the first portion of the email address in the box adjacent to Username and enter the password for that user in the space next to Password. Then press the button labeled Add The User.\n"; + print "

    If you do not want to add a new user at this time then select a choice from the menu at the left, such as List Mailboxes.\n"; + print "\n"; + $printmainpage=0; + +} elsif ($query->param('addmailbox') ne '') { + + my $username = $query->cookie(-name=>'username'); # session checked + select_package($username) unless $current_package; + my $account = $query->param('account'); + my $_password = $query->param('_password'); + + if ( my $error = add_mailbox ( { + 'authuser' => $username, + 'package' => $current_package, + 'account' => $account, + '_password' => $_password, + } ) ) { + print "$body\n"; + print "

    $error\n"; + print "\n"; + + } else { + print "$body\n"; + print "

    Created\n"; + print "\n"; + } + + $printmainpage=0; + +} elsif ($query->param('action') eq 'deleteforward') { + + my $username = $query->cookie(-name=>'username'); # session checked + select_package($username) unless $current_package; + my $svcnum = $query->param('service'); + my $mailbox = $query->param('mailbox'); + my $dest = $query->param('dest'); + print "$body\n"; + print "

    \n"; + print "

    Are you certain you want to remove the forwarding from $mailbox to $dest?\n"; + print "

    \n"; + print "\n"; + print "\n"; + $printmainpage=0; + +} elsif ($query->param('deleteforwardy') ne '') { + + my $username = $query->cookie(-name=>'username'); # session checked + select_package($username) unless $current_package; + my $service = $query->param('service'); + + if ( my $error = delete_forward ( { + 'authuser' => $username, + 'svcnum' => $service, + } ) ) { + print "$body\n"; + print "

    $error\n"; + print "\n"; + + } else { + print "$body\n"; + print "

    Forwarding Removed\n"; + print "\n"; + } + + $printmainpage=0; + +} elsif ($query->param('addforward') ne '') { + + my $username = $query->cookie(-name=>'username'); # session checked + select_package($username) unless $current_package; + my $account = $query->param('account'); + my $mailbox = $query->param('mailbox'); + + print "$body\n"; + print "\n"; + print "

    \n"; + print "\n"; + print "\n"; + print "\n"; + print "\n"; + print "
    Forward mail from

    $mailbox:

    to

    Destination:

    \n"; + print "\n"; + print "
    \n"; + print "
    \n"; + print "
    \n"; + print "

    If you would like mail originally destined for the above address to be forwarded to a different email address then type that email address in the box next to Destination: and press the Add the Forwarding button.\n"; + print "

    If you do not want to add mail forwarding then select a choice from the menu at the left, such as List Accounts.\n"; + + $printmainpage=0; + +} elsif ($query->param('addforwarddst') ne '') { + + my $username = $query->cookie(-name=>'username'); # session checked + select_package($username) unless $current_package; + my $account = $query->param('account'); + my $dest = $query->param('dest'); + + if ( my $error = add_forward ( { + 'authuser' => $username, + 'package' => $current_package, + 'source' => $account, + 'dest' => $dest, + } ) ) { + print "$body\n"; + print "

    $error\n"; + print "\n"; + + } else { + print "$body\n"; + print "

    Forwarding Created\n"; + print "\n"; + } + + $printmainpage=0; + +} elsif ($query->param('action') eq 'navframe') { + + print "\n"; + print "

    NCI2000 MAIL ADMIN Web Interface

    \n"; + + print "
    Choose Action:

    \n"; + print "
    \n"; + print "
      \n"; + print "
    \n"; + print "\n"; + print "\n"; + print "\n"; + print "\n"; + print "
  • Log Off
  • List Packages
  • List Accounts
  • Add Account
  • \n"; + + print "


    \n"; + print "\n"; + + $printmainpage = 0; + +} elsif ($query->param('action') eq 'rightmainframe') { + + print "$body\n"; + print "


    \n"; + print "<----- Please choose function on the left menu\n"; + print "

    \n"; + print "

    Choose Log Off when you are finished. This helps prevent unauthorized access to your accounts.\n"; + print "

    Use List Packages when you administer multiple packages. When you have multiple domains at NCI2000 you are likely to have multiple packages. Use of List Packages is not necessary if administer only one package.\n"; + print "

    Use List Accounts to view your current arrangement of mailboxes. From this list you my choose to make changes to existing mailboxes or delete mailboxes. If you would like to modify the forwarding associated with a mailbox then choose it from this list.\n"; + print "

    Use Add Account when you would like an additional mailbox. After you have added the mailbox you may choose to make additional changes from the list provided by List Accounts.\n"; + print "\n"; + + $printmainpage = 0; + +} + + +if ($query->param('action') eq 'login') { + + printheader(); + printlogin(); + +} elsif ($query->param('action') eq 'logout') { + + destroysession(); + printheader(); + printlogin(); + +} elsif ($printmainpage) { + + + print "NCI2000 MAIL ADMIN Web Interface\n"; + print "\n"; + print "\n"; + print "\n"; + print "\n"; + print "\n"; + + +} + +sub getdatetime { + my $today = localtime(time()); + my ($day,$mon,$dayofmon,$time,$year) = split(/\s+/,$today); + my @datemonths = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"); + + my $numidx = "01"; + my ($nummon); + foreach my $mons (@datemonths) { + if ($mon eq $mons) { + $nummon = $numidx; + } + $numidx++; + } + + return "$year-$nummon-$dayofmon $time"; + +} + +sub error { + + my $error = shift; + my $arg1 = shift; + + printheader(); + + if ($error eq 'not_admin') { + print "Error!\n"; + print "$body\n"; + print "

    Error!

    \n"; + print "Unauthorized attempt to access mail administration.\n"; + print "
    Please login again if you think this is an error.\n"; + print "
    \n"; + print "\n"; + } elsif ($error eq 'exists') { + print "Error!\n"; + print "$body\n"; + print "

    Error!

    \n"; + print "The user you are trying to enter already exists. Please go back and enter a different username\n"; + print "\n"; + } elsif ($error eq 'ingroup') { + print "Error!\n"; + print "$body\n"; + print "

    Error!

    \n"; + print "This user is already in the group $arg1. Please go back and deselect group $arg1 from the list.\n"; + print "
    \n"; + print "\n"; + } elsif ($error eq 'sess_expired') { + print "$body\n"; + print "
    Your session has expired.
    \n"; + print "

    Please login again HERE
    \n"; + print "\n"; + } elsif ($error eq 'open') { + print "$body\n"; + print "
    Unable to open or rename file.
    \n"; + print "

    If this continues, please contact your administrator
    \n"; + print "\n"; + } + + + exit; + +} + + +#print a html header if not printed yet +sub printheader { + + if ($printheader) { + print "Content-Type: text/html\n\n"; + $printheader = 0; + } + +} + + +#verify user can access administration +sub checksession { + + my $username = $query->cookie(-name=>'username'); + my $sessionid = $query->cookie(-name=>'ma_sessionid'); + + if ($sessionid eq '') { + printheader(); + if ($query->param()) { + error('sess_expired'); + } else { + printlogin(); + exit; + } + } + + my $now = time(); + my $founduser = 0; + open(SESSFILE, "$sessionfile") || error('open'); + error('open') if -l "$tmpdir/adminsess.$$"; + open(NEWSESS, ">$tmpdir/adminsess.$$") || error('open'); + while () { + chomp(); + my ($user, $sess, $time, $pkgnum, $svcdomain, $domname) = split(/\s+/); + next if $now - $sessexpire > $time; + if ($username eq $user && !$founduser) { + if ($sess eq $sessionid) { + $founduser = 1; + print NEWSESS "$user $sess $now $pkgnum $svcdomain $domname\n"; + $current_package=$pkgnum; + $current_account=$svcdomain; + $current_domname=$domname; + next; + } + } + print NEWSESS "$user $sess $time $pkgnum $svcdomain $domname\n"; + } + close(SESSFILE); + close(NEWSESS); + system("mv $tmpdir/adminsess.$$ $sessionfile"); + error('sess_expired') unless $founduser; + + my $cookie1 = $query->cookie(-name=>'username', + -value=>$username, + -expires=>$cookieexpire, + -domain=>$cookiedomain); + + my $cookie2 = $query->cookie(-name=>'ma_sessionid', + -value=>$sessionid, + -expires=>$cookieexpire, + -domain=>$cookiedomain); + + print $query->header(-COOKIE=>[$cookie1, $cookie2]); + + $printheader = 0; + + return 0; + +} + +sub destroysession { + + my $username = $query->cookie(-name=>'username'); + my $sessionid = $query->cookie(-name=>'ma_sessionid'); + + if ($sessionid eq '') { + printheader(); + if ($query->param()) { + error('sess_expired'); + } else { + printlogin(); + exit; + } + } + + my $now = time(); + my $founduser = 0; + open(SESSFILE, "$sessionfile") || error('open'); + error('open') if -l "$tmpdir/adminsess.$$"; + open(NEWSESS, ">$tmpdir/adminsess.$$") || error('open'); + while () { + chomp(); + my ($user, $sess, $time, $pkgnum, $svcdomain, $domname) = split(/\s+/); + next if $now - $sessexpire > $time; + if ($username eq $user && !$founduser) { + if ($sess eq $sessionid) { + $founduser = 1; + next; + } + } + print NEWSESS "$user $sess $time $pkgnum $svcdomain $domname\n"; + } + close(SESSFILE); + close(NEWSESS); + system("mv $tmpdir/adminsess.$$ $sessionfile"); + error('sess_expired') unless $founduser; + + $printheader = 0; + + return 0; + +} + +# checks the username and pass against the database +sub checkuserpass { + + my $username = shift; + my $password = shift; + + my $error = authenticate ( { + 'authuser' => $username, + '_password' => $password, + } ); + + if ($error eq "$username OK") { + return 1; + }else{ + return 0; + } + +} + +#printlogin prints a login page +sub printlogin { + + print "$body\n"; + print "
    Please login to access MAIL ADMIN
    \n"; + print "
    \n"; + print "
    Email Address:   \n"; + print "
    Email Password: \n"; + print "
    \n"; + print "
    \n"; + print "\n"; +} + + +#select_package chooses a administrable package if more than one exists +sub select_package { + my $user = shift; + my $packages = list_packages($user); + if (scalar(@{$packages}) eq 1) { + $current_package = @{$packages}[0]->{'pkgnum'}; + set_package(); + } + if (scalar(@{$packages}) > 1) { +# print $query->redirect("$cgi\?action=list_packages"); + print "

    No package selected. You must first select a package.\n"; + exit; + } +} + +sub set_package { + + my $username = $query->cookie(-name=>'username'); + my $sessionid = $query->cookie(-name=>'ma_sessionid'); + + if ($sessionid eq '') { + printheader(); + if ($query->param()) { + error('sess_expired'); + } else { + printlogin(); + exit; + } + } + + my $now = time(); + my $founduser = 0; + open(SESSFILE, "$sessionfile") || error('open'); + error('open') if -l "$tmpdir/adminsess.$$"; + open(NEWSESS, ">$tmpdir/adminsess.$$") || error('open'); + while () { + chomp(); + my ($user, $sess, $time, $pkgnum, $svcdomain, $domname) = split(/\s+/); + next if $now - $sessexpire > $time; + if ($username eq $user && !$founduser) { + if ($sess eq $sessionid) { + $founduser = 1; + print NEWSESS "$user $sess $time $current_package $current_account $current_domname\n"; + next; + } + } + print NEWSESS "$user $sess $time $pkgnum $svcdomain $domname\n"; + } + close(SESSFILE); + close(NEWSESS); + system("mv $tmpdir/adminsess.$$ $sessionfile"); + error('sess_expired') unless $founduser; + + $printheader = 0; + + return 0; + +} + diff --git a/fs_selfadmin/FS-MailAdminServer/fs_mailadmind b/fs_selfadmin/FS-MailAdminServer/fs_mailadmind new file mode 100755 index 000000000..746d7822e --- /dev/null +++ b/fs_selfadmin/FS-MailAdminServer/fs_mailadmind @@ -0,0 +1,366 @@ +#!/usr/bin/perl -Tw + +eval 'exec /usr/bin/perl -Tw -S $0 ${1+"$@"}' + if 0; # not running under some shell +# +# fs_mailadmind +# +# This is run REMOTELY over ssh by fs_mailadmin_server. +# + +use strict; +use Socket; + +use vars qw( $Debug ); + +$Debug = 0; + +my($fs_mailadmind_socket)="/usr/local/freeside/fs_mailadmind_socket"; + +$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'} = ''; + +$|=1; + +warn "[fs_mailadmind] Reading locales...\n" if $Debug; +chomp( my $n_cust_main_county = ); +my @cust_main_county = map { + chomp( my $taxnum = ); + chomp( my $state = ); + chomp( my $county = ); + chomp( my $country = ); + { + 'taxnum' => $taxnum, + 'state' => $state, + 'county' => $county, + 'country' => $country, + }; +} ( 1 .. $n_cust_main_county ); + +warn "[fs_mailadmind] Reading package definitions...\n" if $Debug; +chomp( my $n_part_pkg = ); +my @part_pkg = map { + chomp( my $pkgpart = ); + chomp( my $pkg = ); + { + 'pkgpart' => $pkgpart, + 'pkg' => $pkg, + }; +} ( 1 .. $n_part_pkg ); + +warn "[fs_mailadmind] Reading POPs...\n" if $Debug; +chomp( my $n_svc_acct_pop = ); +my @svc_acct_pop = map { + chomp( my $popnum = ); + chomp( my $city = ); + chomp( my $state = ); + chomp( my $ac = ); + chomp( my $exch = ); + chomp( my $loc = ); + { + 'popnum' => $popnum, + 'city' => $city, + 'state' => $state, + 'ac' => $ac, + 'exch' => $exch, + 'loc' => $loc, + }; +} ( 1 .. $n_svc_acct_pop ); + +warn "[fs_mailadmind] Creating $fs_mailadmind_socket\n" if $Debug; +my $uaddr = sockaddr_un($fs_mailadmind_socket); +my $proto = getprotobyname('tcp'); +socket(Server,PF_UNIX,SOCK_STREAM,0) or die "socket: $!"; +unlink($fs_mailadmind_socket); +bind(Server, $uaddr) or die "bind: $!"; +listen(Server,SOMAXCONN) or die "listen: $!"; + +warn "[fs_mailadmind] Entering main loop...\n" if $Debug; +my $paddr; +for ( ; $paddr = accept(Client,Server); close Client) { + + chop( my $command = ); + + if ( $command eq "signup_info" ) { + warn "[fs_mailadmind] sending signup info...\n" if $Debug; + print Client join("\n", $n_cust_main_county, + map { + $_->{taxnum}, + $_->{state}, + $_->{county}, + $_->{country}, + } @cust_main_county + ), "\n"; + + print Client join("\n", $n_part_pkg, + map { + $_->{pkgpart}, + $_->{pkg}, + } @part_pkg + ), "\n"; + + print Client join("\n", $n_svc_acct_pop, + map { + $_->{popnum}, + $_->{city}, + $_->{state}, + $_->{ac}, + $_->{exch}, + $_->{loc}, + } @svc_acct_pop + ), "\n"; + + } elsif ( $command eq "new_customer" ) { + warn "[fs_mailadmind] reading customer signup...\n" if $Debug; + my( + $first, $last, $ss, $company, $address1, $address2, $city, $county, + $state, $zip, $country, $daytime, $night, $fax, $payby, $payinfo, + $paydate, $payname, $invoicing_list, $pkgpart, $username, $password, + $popnum, + ) = map { scalar() } ( 1 .. 23 ); + + warn "[fs_mailadmind] sending customer data to remote server...\n" if $Debug; + print + $first, $last, $ss, $company, $address1, $address2, $city, $county, + $state, $zip, $country, $daytime, $night, $fax, $payby, $payinfo, + $paydate, $payname, $invoicing_list, $pkgpart, $username, $password, + $popnum, + ; + + warn "[fs_mailadmind] reading error from remote server...\n" if $Debug; + my $error = ; + + warn "[fs_mailadmind] sending error to local client...\n" if $Debug; + print Client $error; + + } elsif ( $command eq "authenticate" ) { + warn "[fs_mailadmind] reading user information to auth...\n" if $Debug; + chop( my $user = ); + warn "[fs_mailadmind] reading authentication material...\n" if $Debug; + chop( my $password = ); + warn "[fs_mailadmind] sending information to remote server...\n" if $Debug; + print "authenticate\n", $user, "\n", $password, "\n"; + + warn "[fs_mailadmind] reading error from remote server...\n" if $Debug; + my $error = ; + + warn "[fs_mailadmind] sending error to local client...\n" if $Debug; + print Client $error; + + } elsif ( $command eq "list_packages" ) { + warn "[fs_mailadmind] reading user information to list_packages...\n" if $Debug; + chop( my $user = ); + warn "[fs_mailadmind] sending user information to remote server...\n" if $Debug; + print "list_packages\n", $user, "\n"; + + warn "[fs_mailadmind] reading data from remote server...\n" if $Debug; + chomp( my $n_packages = ); + my @packages = map { + chomp( my $pkgnum = ); + chomp( my $domain = ); + chomp( my $account = ); + { + 'pkgnum' => $pkgnum, + 'domain' => $domain, + 'account' => $account, + }; + } ( 1 .. $n_packages ); + + warn "[fs_mailadmind] sending data to local client...\n" if $Debug; + + print Client join("\n", $n_packages, + map { + $_->{pkgnum}, + $_->{domain}, + $_->{account}, + } @packages + ), "\n"; + + } elsif ( $command eq "list_mailboxes" ) { + warn "[fs_mailadmind] reading user information to list_mailboxes...\n" if $Debug; + chop( my $user = ); + warn "[fs_mailadmind] reading package number to list_mailboxes...\n" if $Debug; + chop( my $package = ); + warn "[fs_mailadmind] sending user information to remote server...\n" if $Debug; + print "list_mailboxes\n", $user, "\n", $package, "\n"; + + warn "[fs_mailadmind] reading data from remote server...\n" if $Debug; + chomp( my $n_svc_acct = ); + my @svc_acct = map { + chomp( my $svcnum = ); + chomp( my $username = ); + chomp( my $_password = ); + { + 'svcnum' => $svcnum, + 'username' => $username, + '_password' => $_password, + }; + } ( 1 .. $n_svc_acct ); + + warn "[fs_mailadmind] sending data to local client...\n" if $Debug; + + print Client join("\n", $n_svc_acct, + map { + $_->{svcnum}, + $_->{username}, + $_->{_password}, + } @svc_acct + ), "\n"; + + } elsif ( $command eq "delete_mailbox" ) { + warn "[fs_mailadmind] reading user information to auth...\n" if $Debug; + chop( my $user = ); + warn "[fs_mailadmind] reading account information to delete...\n" if $Debug; + chop( my $account = ); + warn "[fs_mailadmind] sending information to remote server...\n" if $Debug; + print "delete_mailbox\n", $user, "\n", $account, "\n"; + + warn "[fs_mailadmind] reading error from remote server...\n" if $Debug; + my $error = ; + + warn "[fs_mailadmind] sending error to local client...\n" if $Debug; + print Client $error; + + } elsif ( $command eq "password_mailbox" ) { + warn "[fs_mailadmind] reading user information to auth...\n" if $Debug; + chop( my $user = ); + warn "[fs_mailadmind] reading account information to password...\n" if $Debug; + my( + $account, $_password, + ) = map { scalar() } ( 1 .. 2 ); + + warn "[fs_mailadmind] sending password data to remote server...\n" if $Debug; + print "password_mailbox", "\n"; + print + $user, "\n", $account, $_password, + ; + + warn "[fs_mailadmind] reading error from remote server...\n" if $Debug; + my $error = ; + + warn "[fs_mailadmind] sending error to local client...\n" if $Debug; + print Client $error; + + } elsif ( $command eq "add_mailbox" ) { + warn "[fs_mailadmind] reading user information to auth...\n" if $Debug; + chop( my $user = ); + warn "[fs_mailadmind] reading account information to create...\n" if $Debug; + my( + $package, $account, $_password, + ) = map { scalar() } ( 1 .. 3 ); + + warn "[fs_mailadmind] sending service data to remote server...\n" if $Debug; + print "add_mailbox", "\n"; + print + $user, "\n", $package, $account, $_password, + ; + + warn "[fs_mailadmind] reading error from remote server...\n" if $Debug; + my $error = ; + + warn "[fs_mailadmind] sending error to local client...\n" if $Debug; + print Client $error; + + } elsif ( $command eq "add_forward" ) { + warn "[fs_mailadmind] reading user information to auth...\n" if $Debug; + chop( my $user = ); + warn "[fs_mailadmind] reading forward information to create...\n" if $Debug; + my( + $package, $source, $dest, + ) = map { scalar() } ( 1 .. 3 ); + + warn "[fs_mailadmind] sending service data to remote server...\n" if $Debug; + print "add_forward", "\n"; + print + $user, "\n", $package, $source, $dest, + ; + + warn "[fs_mailadmind] reading error from remote server...\n" if $Debug; + my $error = ; + + warn "[fs_mailadmind] sending error to local client...\n" if $Debug; + print Client $error; + + } elsif ( $command eq "delete_forward" ) { + warn "[fs_mailadmind] reading user information to auth...\n" if $Debug; + chop( my $user = ); + warn "[fs_mailadmind] reading forward information to delete...\n" if $Debug; + chop( my $service = ); + warn "[fs_mailadmind] sending information to remote server...\n" if $Debug; + print "delete_forward\n", $user, "\n", $service, "\n"; + + warn "[fs_mailadmind] reading error from remote server...\n" if $Debug; + my $error = ; + + warn "[fs_mailadmind] sending error to local client...\n" if $Debug; + print Client $error; + + } elsif ( $command eq "list_forwards" ) { + warn "[fs_mailadmind] reading user information to list_forwards...\n" if $Debug; + chop( my $user = ); + warn "[fs_mailadmind] reading service number to list_forwards...\n" if $Debug; + chop( my $service = ); + warn "[fs_mailadmind] sending user information to remote server...\n" if $Debug; + print "list_forwards\n", $user, "\n", $service, "\n"; + + warn "[fs_mailadmind] reading data from remote server...\n" if $Debug; + chomp( my $n_svc_forward = ); + my @svc_forward = map { + chomp( my $svcnum = ); + chomp( my $dest = ); + { + 'svcnum' => $svcnum, + 'dest' => $dest, + }; + } ( 1 .. $n_svc_forward ); + + warn "[fs_mailadmind] sending data to local client...\n" if $Debug; + + print Client join("\n", $n_svc_forward, + map { + $_->{svcnum}, + $_->{dest}, + } @svc_forward + ), "\n"; + + } elsif ( $command eq "list_pkg_forwards" ) { + warn "[fs_mailadmind] reading user information to list_pkg_forwards...\n" if $Debug; + chop( my $user = ); + warn "[fs_mailadmind] reading service number to list_forwards...\n" if $Debug; + chop( my $package = ); + warn "[fs_mailadmind] sending user information to remote server...\n" if $Debug; + print "list_pkg_forwards\n", $user, "\n", $package, "\n"; + + warn "[fs_mailadmind] reading data from remote server...\n" if $Debug; + chomp( my $n_svc_forward = ); + my @svc_forward = map { + chomp( my $svcnum = ); + chomp( my $srcsvc = ); + chomp( my $dest = ); + { + 'svcnum' => $svcnum, + 'srcsvc' => $srcsvc, + 'dest' => $dest, + }; + } ( 1 .. $n_svc_forward ); + + warn "[fs_mailadmind] sending data to local client...\n" if $Debug; + + print Client join("\n", $n_svc_forward, + map { + $_->{svcnum}, + $_->{srcsvc}, + $_->{dest}, + } @svc_forward + ), "\n"; + + } else { + die "unexpected command from client: $command"; + } + +} + diff --git a/fs_selfadmin/README b/fs_selfadmin/README new file mode 100644 index 000000000..d9857f054 --- /dev/null +++ b/fs_selfadmin/README @@ -0,0 +1,27 @@ + +This collection of files implements a 'self-administered mail service.' +Configuration is similar to fs_signupd + +Additionally you will need to modify the database: + +CREATE TABLE svc_acct_admin ( + svcnum int primary key, + adminsvc int not null +); + +creating both as keys might be good + +(and perform the dbdef-create) + + +As it exists now, a package containing one svc_domain, at least one +svc_acct_admin, and other services can have its svc_acct's and svc_forward's +manipulated by the svc_acct referenced by a svc_acct_admin in the package. + +One svc_acct may be referenced as svc_acct_admin for multiple packages. + +fs_mailadmin_server contains hard coded references to service numbers which +will require editing for your system. + +It's not a lot, but it might provide inspiration. + diff --git a/fs_selfadmin/fs_mailadmin_server b/fs_selfadmin/fs_mailadmin_server new file mode 100755 index 000000000..ef4788543 --- /dev/null +++ b/fs_selfadmin/fs_mailadmin_server @@ -0,0 +1,642 @@ +#!/usr/bin/perl -Tw +# +# fs_mailadmin_server +# + +use strict; +use IO::Handle; +use FS::SSH qw(sshopen2); +use FS::UID qw(adminsuidsetup); +use FS::Conf; +use FS::Record qw( qsearch qsearchs ); +use FS::cust_main_county; +use FS::cust_main; +use FS::svc_acct_admin; + +use vars qw( $opt $Debug $conf $default_domain ); + +$Debug = 1; + +#my @payby = qw(CARD PREPAY); + +my $user = shift or die &usage; +&adminsuidsetup( $user ); + +$conf = new FS::Conf; +$default_domain = $conf->config('domain'); + +my $machine = shift or die &usage; + +my $agentnum = shift or die &usage; +my $agent = qsearchs( 'agent', { 'agentnum' => $agentnum } ) or die &usage; +my $pkgpart = $agent->pkgpart_hashref; + +my $refnum = shift or die &usage; + +#causing trouble for some folks +#$SIG{CHLD} = sub { wait() }; + +my($fs_mailadmind)=$conf->config('fs_mailadmind'); + +while (1) { + my($reader,$writer)=(new IO::Handle, new IO::Handle); + $writer->autoflush(1); + warn "[fs_mailadmin_server] Connecting to $machine...\n" if $Debug; + sshopen2($machine,$reader,$writer,$fs_mailadmind); + + my $data; + + warn "[fs_mailadmin_server] Sending locales...\n" if $Debug; + my @cust_main_county = qsearch('cust_main_county', {} ); + print $writer $data = join("\n", + ( scalar(@cust_main_county) || die "no tax rates (cust_main_county records)" ), + map { + $_->taxnum, + $_->state, + $_->county, + $_->country, + } @cust_main_county + ),"\n"; + warn "[fs_mailadmin_server] $data\n" if $Debug > 2; + + warn "[fs_mailadmin_server] Sending package definitions...\n" if $Debug; + my @part_pkg = grep { $_->svcpart('svc_acct') && $pkgpart->{ $_->pkgpart } } + qsearch( 'part_pkg', {} ); + print $writer $data = join("\n", + ( scalar(@part_pkg) || die "no usable package definitions, agent $agentnum" ), + map { + $_->pkgpart, + $_->pkg, + } @part_pkg + ), "\n"; + warn "[fs_mailadmin_server] $data\n" if $Debug > 2; + + warn "[fs_mailadmin_server] Sending POPs...\n" if $Debug; + my @svc_acct_pop = qsearch ('svc_acct_pop',{} ); + print $writer $data = join("\n", + ( scalar(@svc_acct_pop) || die "No points of presence (svc_acct_pop records)" ), + map { + $_->popnum, + $_->city, + $_->state, + $_->ac, + $_->exch, + $_->loc, + } @svc_acct_pop + ), "\n"; + warn "[fs_mailadmin_server] $data\n" if $Debug > 2; + + warn "[fs_mailadmin_server] Entering main loop...\n" if $Debug; +COMMAND: while (1) { + warn "[fs_mailadmin_server] Reading (waiting for) command...\n" if $Debug; + chop( my($command, $user) = map { scalar(<$reader>) } ( 1 .. 2 ) ); + my $domain = $default_domain; + $user =~ /^([\w\.\-]+)\@(([\w\-]+\.)+\w+)$/; + ($user, $domain) = ($1, $2); + + if ($command eq 'authenticate'){ + warn "[fs_mailadmin_server] Processing authenticate command for $user \n" if $Debug; + chop( my($password) = map { scalar(<$reader>) } ( 1 .. 1 ) ); + + my $error = ''; + + my @svc_domain = qsearchs('svc_domain', { 'domain' => $domain }); + + if (scalar(@svc_domain) != 1) { + warn "Nonexistant or duplicate service account for \"$domain\""; + next COMMAND; + } + + my @svc_acct = qsearchs('svc_acct', { 'username' => $user, + 'domsvc' => $svc_domain[0]->svcnum }); + if (scalar(@svc_acct) != 1) { + die "Nonexistant or duplicate service account for \"$user\""; + next COMMAND; + } + + if ($svc_acct[0]->_password eq $password) { + $error = "$user\@$domain OK"; + }else{ + $error = "$user\@$domain FAILED"; + } + warn "[fs_mailadmin_server] Sending results...\n" if $Debug; + print $writer $error, "\n"; + } + elsif ($command eq 'list_packages'){ + warn "[fs_mailadmin_server] Processing list_packages command for $user \n" if $Debug; + + my $error = ''; + + my @packages = eval {find_administrable_packages( $user, $domain )}; + warn "$@" if $@; + + my %packages; + my %accounts; + + foreach my $package (@packages) { + $packages{my $pkgnum = $package->getfield('pkgnum')} = $default_domain; + $accounts{$pkgnum} = 0; + my @services = qsearch('cust_svc', { 'pkgnum' => $pkgnum }); + foreach my $service (@services) { + if ($service->getfield('svcpart') eq '4'){ + my $account=qsearchs('svc_domain', { 'svcnum' => $service->getfield('svcnum') }); + $packages{$pkgnum}=$account->getfield('domain'); + $accounts{$pkgnum}=$account->getfield('svcnum'); + } + } + } + + print $writer $data = join("\n", + ( scalar(keys(%packages)) ), + map { + $_, + $packages{$_}, + $accounts{$_}, + } keys(%packages) + ), "\n"; + warn "[fs_mailadmin_server] $data\n" if $Debug > 2; + + }elsif ($command eq 'list_mailboxes'){ + + warn "[fs_mailadmin_server] Processing list_mailboxes command for $user" if $Debug; + chop( my($pkgnum) = map { scalar(<$reader>) } ( 1 .. 1 ) ); + warn "package $pkgnum \n" if $Debug; + + my $error = ''; + + my @packages = eval {find_administrable_packages( $user, $domain )}; + warn "$@" if $@; + + my @accounts; + + foreach my $package (@packages) { + next unless ($pkgnum eq $package->getfield('pkgnum')); + my @services = qsearch('cust_svc', { 'pkgnum' => $package->getfield('pkgnum') }); + foreach my $service (@services) { + if ($service->getfield('svcpart') eq '2'){ + my $account=qsearchs('svc_acct', { 'svcnum' => $service->getfield('svcnum') }); +# $accounts[$#accounts+1]=$account->getfield('username'); + $accounts[$#accounts+1]=$account; + } + } + } + + print $writer $data = join("\n", +# ( scalar(@accounts) || die "No accounts (svc_acct records)" ), + ( scalar(@accounts) ), + map { + $_->svcnum, +# $_->username, + $_->email, +# $_->_password, + '*****', + } @accounts + ), "\n"; + warn "[fs_mailadmin_server] $data\n" if $Debug > 2; + + + } elsif ($command eq 'delete_mailbox'){ + warn "[fs_mailadmin_server] Processing delete_mailbox command for $user " if $Debug; + chop( my($account) = map { scalar(<$reader>) } ( 1 .. 1 ) ); + warn "account $account \n" if $Debug; + + my $error = ''; + + my @packages = eval { find_administrable_packages($user, $domain) }; + warn "$@" if $@; + $error ||= "$@" if $@; + + my @svc_acct = qsearchs('svc_acct', { 'svcnum' => $account }) unless $error; + if (scalar(@svc_acct) != 1) { $error ||= 'Nonexistant or duplicate service account for user.' }; + if (! $error && check_administrator(\@packages, $svc_acct[0])){ +# not sure about the next three lines... do we delete? or return error + foreach my $svc_forward (qsearch('svc_forward', { 'dstsvc' => $svc_acct[0]->getfield('svcnum') })) { + $error ||= $svc_forward->delete; + } + foreach my $svc_forward (qsearch('svc_forward', { 'srcsvc' => $svc_acct[0]->getfield('svcnum') })) { + $error ||= $svc_forward->delete; + } + $error ||= $svc_acct[0]->delete; + } else { + $error ||= "Illegal attempt to remove service"; + } + + + warn "[fs_mailadmin_server] Sending results...\n" if $Debug; + print $writer $error, "\n"; + + } elsif ($command eq 'password_mailbox'){ + warn "[fs_mailadmin_server] Processing password_mailbox command for $user " if $Debug; + chop( my($account, $_password) = map { scalar(<$reader>) } ( 1 .. 2 ) ); + warn "account $account with password $_password \n" if $Debug; + + my $error = ''; + + my @packages = eval { find_administrable_packages($user, $domain) }; + warn "$@" if $@; + $error ||= "$@" if $@; + + my @svc_acct = qsearchs('svc_acct', { 'svcnum' => $account }) unless $error; + if (scalar(@svc_acct) != 1) { $error ||= 'Nonexistant or duplicate service account.' }; + + if (! $error && check_administrator(\@packages, $svc_acct[0])){ + my $new = new FS::svc_acct ({$svc_acct[0]->hash}); + $new->setfield('_password' => $_password); + $error ||= $new->replace($svc_acct[0]); + } else { + $error ||= "Illegal attempt to change password"; + } + + + warn "[fs_mailadmin_server] Sending results...\n" if $Debug; + print $writer $error, "\n"; + + } elsif ($command eq 'add_mailbox'){ + warn "[fs_mailadmin_server] Processing add_mailbox command for $user " if $Debug; + chop( my($target_package, $account, $_password) = map { scalar(<$reader>) } ( 1 .. 3 ) ); + warn "in package $target_package account $account with password $_password \n" if $Debug; + + my $found_package; + my $domainsvc=0; + my $svcpart=2; # this is 'email box' + my $svcpartsm=3; # this is 'domain alias' + my $error = ''; + my $found = 0; + + my @packages = eval { find_administrable_packages($user, $domain) }; + warn "$@" if $@; + $error ||= "$@" if $@; + + foreach my $package (@packages) { + if ($package->getfield('pkgnum') eq $target_package) { + $found = 1; + $found_package=$package; + my @services = qsearch('cust_svc', { 'pkgnum' => $target_package }); + foreach my $service (@services) { + if ($service->getfield('svcpart') eq '4'){ + my @svc_domain=qsearchs('svc_domain', { 'svcnum' => $service->getfield('svcnum') }); + if (scalar(@svc_domain) eq 1) { + $domainsvc=$svc_domain[0]->getfield('svcnum'); + } + } + } + last; + } + } + warn "User $user does not have administration rights to package $target_package\n" unless $found; + $error ||= "User $user does not have administration rights to package $target_package\n" unless $found; + + my $part_pkg = qsearchs('part_pkg',{'pkgpart'=>$found_package->getfield('pkgpart')}); + + #list of services this pkgpart includes (although at the moment we only care + # about $svcpart + my $pkg_svc; + my %pkg_svc = (); + foreach $pkg_svc ( qsearch('pkg_svc',{'pkgpart'=> $found_package->pkgpart }) ) { + $pkg_svc{$pkg_svc->svcpart} = $pkg_svc->quantity if $pkg_svc->quantity; + } + + my @services = qsearch('cust_svc', {'pkgnum' => $found_package->getfield('pkgnum'), + 'svcpart' => $svcpart, + }); + + if (scalar(@services) >= $pkg_svc{$svcpart}) { + $error="Maximum allowed already reached."; + } + + my $svc_acct = new FS::svc_acct ( { + 'pkgnum' => $found_package->pkgnum, + 'svcpart' => $svcpart, + 'username' => $account, + 'domsvc' => $domainsvc, + '_password' => $_password, + } ); + + my $y = $svc_acct->setdefault; # arguably should be in new method + $error ||= $y unless ref($y); + #and just in case you were silly + $svc_acct->pkgnum($found_package->pkgnum); + $svc_acct->svcpart($svcpart); + $svc_acct->username($account); + $svc_acct->domsvc($domainsvc); + $svc_acct->_password($_password); + + $error ||= $svc_acct->check; + + if ( ! $error ) { #in this case, $cust_pkg should always + #be definied, but.... + $error ||= $svc_acct->insert; + warn "WARNING: $error on pre-checked svc_acct record!" if $error; + } + + warn "[fs_mailadmin_server] Sending results...\n" if $Debug; + print $writer $error, "\n"; + + }elsif ($command eq 'list_forwards'){ + + warn "[fs_mailadmin_server] Processing list_forwards command for $user" if $Debug; + chop( my($svcnum) = map { scalar(<$reader>) } ( 1 .. 1 ) ); + warn "service $svcnum \n" if $Debug; + + my $error = ''; + + my @packages = eval {find_administrable_packages( $user, $domain )}; + warn "$@" if $@; + + my @forwards; + + foreach my $package (@packages) { +# next unless ($pkgnum eq $package->getfield('pkgnum')); + my @services = qsearch('cust_svc', { 'pkgnum' => $package->getfield('pkgnum') }); + foreach my $service (@services) { + if ($service->getfield('svcpart') eq '10'){ + my $forward=qsearchs('svc_forward', { 'svcnum' => $service->getfield('svcnum') }); + $forwards[$#forwards+1]=$forward if ($forward->getfield('srcsvc') == $svcnum); + } + } + } + + print $writer $data = join("\n", + ( scalar(@forwards) ), + map { + $_->svcnum, + ($_->dstsvc ? qsearchs('svc_acct', {'svcnum' => $_->dstsvc})->email : $_->dst), + } @forwards + ), "\n"; + warn "[fs_mailadmin_server] $data\n" if $Debug > 2; + + + }elsif ($command eq 'list_pkg_forwards'){ + + warn "[fs_mailadmin_server] Processing list_pkg_forwards command for $user" if $Debug; + chop( my($pkgnum) = map { scalar(<$reader>) } ( 1 .. 1 ) ); + warn "package $pkgnum \n" if $Debug; + + my $error = ''; + + my @packages = eval {find_administrable_packages( $user, $domain )}; + warn "$@" if $@; + + my @forwards; + + foreach my $package (@packages) { + next unless ($pkgnum eq $package->getfield('pkgnum')); + my @services = qsearch('cust_svc', { 'pkgnum' => $package->getfield('pkgnum') }); + foreach my $service (@services) { + if ($service->getfield('svcpart') eq '10'){ + my $forward=qsearchs('svc_forward', { 'svcnum' => $service->getfield('svcnum') }); + $forwards[$#forwards+1]=$forward; + } + } + } + + print $writer $data = join("\n", + ( scalar(@forwards) ), + map { + $_->svcnum, + $_->srcsvc, + ($_->dstsvc ? qsearchs('svc_acct', {'svcnum' => $_->dstsvc})->email : $_->dst), + } @forwards + ), "\n"; + warn "[fs_mailadmin_server] $data\n" if $Debug > 2; + + + } elsif ($command eq 'delete_forward'){ + warn "[fs_mailadmin_server] Processing delete_forward command for $user " if $Debug; + chop( my($forward) = map { scalar(<$reader>) } ( 1 .. 1 ) ); + warn "forward $forward \n" if $Debug; + + my $error = ''; + + my @packages = eval { find_administrable_packages($user, $domain) }; + warn "$@" if $@; + $error ||= "$@" if $@; + + my @svc_forward = qsearchs('svc_forward', { 'svcnum' => $forward }) unless $error; + if (scalar(@svc_forward) != 1) { $error ||= 'Nonexistant or duplicate service account for user.' }; + if (! $error && check_administrator(\@packages, $svc_forward[0])){ +# not sure about the next three lines... do we delete? or return error + $error ||= $svc_forward[0]->delete; + } else { + $error ||= "Illegal attempt to remove service"; + } + + + warn "[fs_mailadmin_server] Sending results...\n" if $Debug; + print $writer $error, "\n"; + + } elsif ($command eq 'add_forward'){ + warn "[fs_mailadmin_server] Processing add_forward command for $user " if $Debug; + chop( my($target_package, $source, $dest) = map { scalar(<$reader>) } ( 1 .. 3 ) ); + warn "in package $target_package source $source with destination $dest \n" if $Debug; + + my $found_package; + my $domainsvc=0; + my $svcpart=10; # this is 'forward service' + my $error = ''; + my $found = 0; + + my @packages = eval { find_administrable_packages($user, $domain) }; + warn "$@" if $@; + $error ||= "$@" if $@; + + foreach my $package (@packages) { + if ($package->getfield('pkgnum') eq $target_package) { + $found = 1; + $found_package=$package; + last; + } + } + warn "User $user does not have administration rights to package $target_package\n" unless $found; + $error ||= "User $user does not have administration rights to package $target_package\n" unless $found; + + my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $source }); + warn "Forwarding source $source does not exist.\n" unless $svc_acct; + $error ||= "Forwarding source $source does not exist.\n" unless $svc_acct; + + my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $source }); + warn "Forwarding source $source not attached to any account.\n" unless $cust_svc; + $error ||= "Forwarding source $source not attached to any account.\n" unless $cust_svc; + + if ( ! $error ) { + warn "Forwarding source $source is not in package $target_package\n" + unless ($cust_svc->getfield('pkgnum') == $target_package); + $error ||= "Forwarding source $source is not in package $target_package\n" + unless ($cust_svc->getfield('pkgnum') == $target_package); + } + + my $part_pkg = qsearchs('part_pkg',{'pkgpart'=>$found_package->getfield('pkgpart')}); + + #list of services this pkgpart includes (although at the moment we only care + # about $svcpart + my $pkg_svc; + my %pkg_svc = (); + foreach $pkg_svc ( qsearch('pkg_svc',{'pkgpart'=> $found_package->pkgpart }) ) { + $pkg_svc{$pkg_svc->svcpart} = $pkg_svc->quantity if $pkg_svc->quantity; + } + + my @services = qsearch('cust_svc', {'pkgnum' => $found_package->getfield('pkgnum'), + 'svcpart' => $svcpart, + }); + + if (scalar(@services) >= $pkg_svc{$svcpart}) { + $error="Maximum allowed already reached."; + } + + my $svc_forward = new FS::svc_forward ( { + 'pkgnum' => $found_package->pkgnum, + 'svcpart' => $svcpart, + 'srcsvc' => $source, + 'dstsvc' => 0, + 'dst' => $dest, + } ); + + my $y = $svc_forward->setdefault; # arguably should be in new method + $error ||= $y unless ref($y); + #and just in case you were silly + $svc_forward->pkgnum($found_package->pkgnum); + $svc_forward->svcpart($svcpart); + $svc_forward->srcsvc($source); + $svc_forward->dstsvc(0); + $svc_forward->dst($dest); + + $error ||= $svc_forward->check; + + if ( ! $error ) { #in this case, $cust_pkg should always + #be definied, but.... + $error ||= $svc_forward->insert; + warn "WARNING: $error on pre-checked svc_forward record!" if $error; + } + + warn "[fs_mailadmin_server] Sending results...\n" if $Debug; + print $writer $error, "\n"; + + } else { + warn "[fs_mailadmin_server] Bad command: $command \n" if $Debug; + print $writer "Bad command \n"; + } + } + close $writer; + close $reader; + warn "connection to $machine lost! waiting 60 seconds...\n"; + sleep 60; + warn "reconnecting...\n"; +} + +sub usage { + die "Usage:\n\n fs_mailadmin_server user machine agentnum refnum\n"; +} + +#sub find_administrable_packages { +# my $user = shift; +# +# my $error = ''; +# +# my @svc_acct = qsearchs('svc_acct', { 'username' => $user }); +# if (scalar(@svc_acct) != 1) { +# die "Nonexistant or duplicate service account for \"$user\""; +# } +# +# my @cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_acct[0]->getfield('svcnum') }); +# if (scalar(@cust_svc) != 1 ) { +# die "Nonexistant or duplicate customer service for \"$user\""; +# } +# +# my @cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $cust_svc[0]->getfield('pkgnum') }); +# if (scalar(@cust_pkg) != 1) { +# die "Nonexistant or duplicate customer package for \"$user\""; +# } +# +# my @cust_main = qsearchs('cust_main', { 'custnum' => $cust_pkg[0]->getfield('custnum') }); +# if (scalar(@cust_main) != 1 ) { +# die "Nonexistant or duplicate customer for \"$user\""; +# } +# +# my @packages = $cust_main[0]->ncancelled_pkgs; +#} + +sub find_administrable_packages { + my $user = shift; + my $domain = shift; + + my @packages; + my $error = ''; + + my @svc_domain = qsearchs('svc_domain', { 'domain' => $domain }); + + if (scalar(@svc_domain) != 1) { + die "Nonexistant or duplicate service account for \"$domain\""; + } + + my @svc_acct = qsearchs('svc_acct', { 'username' => $user, + 'domsvc' => $svc_domain[0]->svcnum }); + if (scalar(@svc_acct) != 1) { + die "Nonexistant or duplicate service account for \"$user\""; + } + + my @svc_acct_admin = qsearch('svc_acct_admin', {'adminsvc' => $svc_acct[0]->getfield('svcnum') }); + die "Nonexistant or duplicate customer service for \"$user\"" unless scalar(@svc_acct_admin); + + foreach my $svc_acct_admin (@svc_acct_admin) { + my @cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_acct_admin->getfield('svcnum') }); + if (scalar(@cust_svc) != 1 ) { + die "Nonexistant or duplicate customer service for admin \"$svc_acct_admin->getfield('svcnum')\""; + } + + my @cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $cust_svc[0]->getfield('pkgnum') }); + if (scalar(@cust_pkg) != 1) { + die "Nonexistant or duplicate customer package for admin \"$user\""; + } + + push @packages, $cust_pkg[0] unless $cust_pkg[0]->getfield('cancel'); + + } + (@packages); +} + +sub check_administrator { + my ($allowed_packages_aref, $svc_acct_ref) = @_; + + my $error = ''; + my $found = 0; + + { + my @cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_acct_ref->getfield('svcnum') }); + if (scalar(@cust_svc) != 1 ) { + warn "Nonexistant or duplicate customer service for \"$svc_acct_ref->getfield('username')\""; + last; + } + + my @cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $cust_svc[0]->getfield('pkgnum') }); + if (scalar(@cust_pkg) != 1) { + warn "Nonexistant or duplicate customer package for \"$svc_acct_ref->getfield('username')\""; + last; + } + + foreach my $package (@$allowed_packages_aref) { + if ($package->getfield('pkgnum') eq $cust_pkg[0]->getfield('pkgnum')) { + $found = 1; + last; + } + } + } + + $found; +} + +sub check_add { + my ($allowed_packages_aref, $target_package) = @_; + + my $error = ''; + my $found = 0; + + foreach my $package (@$allowed_packages_aref) { + if ($package->getfield('pkgnum') eq $target_package) { + $found = 1; + last; + } + } + + $found; +} + diff --git a/fs_selfservice/DEPLOY b/fs_selfservice/DEPLOY new file mode 100755 index 000000000..c93ed0fea --- /dev/null +++ b/fs_selfservice/DEPLOY @@ -0,0 +1,29 @@ +#!/bin/sh + +#this is a quick hack for my dev machine. do not use it. +# see the "make install-selfservice" and "make update-selfservice" makefile +# targets to properly install this stuff. + +#kill `cat /var/run/freeside-selfservice-server.fs_selfservice.pid` + +cd FS-SelfService +perl Makefile.PL && make && make install +cd .. + +( cd ..; make deploy; cd fs_selfservice ) + +#cp /home/ivan/freeside/fs_selfservice/FS-SelfService/cgi/* /var/www/MyAccount +#chown freeside /var/www/MyAccount/*.cgi +#chmod 755 /var/www/MyAccount/*.cgi +#ln -s /var/www/MyAccount/selfservice.cgi /var/www/MyAccount/index.cgi || true + + #cp /home/ivan/freeside/fs_signup/FS-SignupClient/cgi/* /var/www/signup/ + ##mv /var/www/signup/signup-snarf.html /var/www/signup/signup.html #!!!!! + ##mv /var/www/signup/signup-billaddress.html /var/www/signup/signup.html #!!!!! + ##mv /var/www/signup/signup-freeoption.html /var/www/signup/signup.html #!!!!! + #chown freeside /var/www/signup/signup.cgi + #chmod 755 /var/www/signup/signup.cgi + #ln -s /var/www/signup/signup.cgi /var/www/signup/index.cgi || true + + +chmod 755 /var/www/selfservice/*.cgi diff --git a/fs_selfservice/FS-SelfService/Changes b/fs_selfservice/FS-SelfService/Changes new file mode 100644 index 000000000..b9e26b7dc --- /dev/null +++ b/fs_selfservice/FS-SelfService/Changes @@ -0,0 +1,6 @@ +Revision history for Perl extension FS::SelfService. + +0.01 Tue May 28 16:49:41 2002 + - original version; created by h2xs 1.21 with options + -A -X -n FS::SelfService + diff --git a/fs_selfservice/FS-SelfService/MANIFEST b/fs_selfservice/FS-SelfService/MANIFEST new file mode 100644 index 000000000..a619b2b6c --- /dev/null +++ b/fs_selfservice/FS-SelfService/MANIFEST @@ -0,0 +1,8 @@ +Changes +Makefile.PL +MANIFEST +SelfService.pm +SelfService/XMLRPC.pm +test.pl +freeside-selfservice-clientd +freeside-selfservice-xmlrpc-server diff --git a/fs_selfservice/FS-SelfService/Makefile.PL b/fs_selfservice/FS-SelfService/Makefile.PL new file mode 100644 index 000000000..c078f0865 --- /dev/null +++ b/fs_selfservice/FS-SelfService/Makefile.PL @@ -0,0 +1,20 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'NAME' => 'FS::SelfService', + 'VERSION_FROM' => 'SelfService.pm', # finds $VERSION + 'EXE_FILES' => [ 'freeside-selfservice-clientd', + 'freeside-selfservice-xmlrpc-server', + ], + 'INSTALLSCRIPT' => '/usr/local/sbin', + 'INSTALLSITEBIN' => '/usr/local/sbin', + 'INSTALLSITESCRIPT' => '/usr/local/sbin', #recent deb users this... + 'PERM_RWX' => '750', + 'PREREQ_PM' => { + 'Storable' => 2.09, + }, # e.g., Module::Name => 1.1 + ($] >= 5.005 ? ## Add these new keywords supported since 5.005 + (ABSTRACT_FROM => 'SelfService.pm', # retrieve abstract from module + AUTHOR => 'Ivan Kohler ') : ()), +); diff --git a/fs_selfservice/FS-SelfService/SelfService.pm b/fs_selfservice/FS-SelfService/SelfService.pm new file mode 100644 index 000000000..ec4668fe8 --- /dev/null +++ b/fs_selfservice/FS-SelfService/SelfService.pm @@ -0,0 +1,1467 @@ +package FS::SelfService; + +use strict; +use vars qw($VERSION @ISA @EXPORT_OK $DEBUG $dir $socket %autoload $tag); +use Exporter; +use Socket; +use FileHandle; +#use IO::Handle; +use IO::Select; +use Storable 2.09 qw(nstore_fd fd_retrieve); + +$VERSION = '0.03'; + +@ISA = qw( Exporter ); + +$DEBUG = 0; + +$dir = "/usr/local/freeside"; +$socket = "$dir/selfservice_socket"; +$socket .= '.'.$tag if defined $tag && length($tag); + +#maybe should ask ClientAPI for this list +%autoload = ( + 'passwd' => 'passwd/passwd', + 'chfn' => 'passwd/passwd', + 'chsh' => 'passwd/passwd', + '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', + 'process_payment' => 'MyAccount/process_payment', + 'process_payment_order_pkg' => 'MyAccount/process_payment_order_pkg', + 'process_prepay' => 'MyAccount/process_prepay', + '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_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', + 'cancel_pkg' => 'MyAccount/cancel_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', + 'signup_info' => 'Signup/signup_info', + 'domain_select_hash' => 'Signup/domain_select_hash', # expose? + 'new_customer' => 'Signup/new_customer', + 'agent_login' => 'Agent/agent_login', + 'agent_logout' => 'Agent/agent_logout', + 'agent_info' => 'Agent/agent_info', + 'agent_list_customers' => 'Agent/agent_list_customers', +); +@EXPORT_OK = ( keys(%autoload), qw( regionselector expselect popselector domainselector) ); + +$ENV{'PATH'} ='/usr/bin:/usr/ucb:/bin'; +$ENV{'SHELL'} = '/bin/sh'; +$ENV{'IFS'} = " \t\n"; +$ENV{'CDPATH'} = ''; +$ENV{'ENV'} = ''; +$ENV{'BASH_ENV'} = ''; + +my $freeside_uid = scalar(getpwnam('freeside')); +die "not running as the freeside user\n" if $> != $freeside_uid; + +-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 as freeside user!"; +-x $dir or die "FATAL: $dir not searchable (executable) as freeside user!"; + +foreach my $autoload ( keys %autoload ) { + + my $eval = + "sub $autoload { ". ' + my $param; + if ( ref($_[0]) ) { + $param = shift; + } else { + #warn scalar(@_). ": ". join(" / ", @_); + $param = { @_ }; + } + + $param->{_packet} = \''. $autoload{$autoload}. '\'; + + simple_packet($param); + }'; + + eval $eval; + die $@ if $@; + +} + +sub simple_packet { + my $packet = shift; + warn "sending ". $packet->{_packet}. " to server" + if $DEBUG; + socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; + connect(SOCK, sockaddr_un($socket)) or die "connect to $socket: $!"; + nstore_fd($packet, \*SOCK) or die "can't send packet: $!"; + SOCK->flush; + + #shoudl trap: Magic number checking on storable file failed at blib/lib/Storable.pm (autosplit into blib/lib/auto/Storable/fd_retrieve.al) line 337, at /usr/local/share/perl/5.6.1/FS/SelfService.pm line 71 + + #block until there is a message on socket +# my $w = new IO::Select; +# $w->add(\*SOCK); +# my @wait = $w->can_read; + + warn "reading message from server" + if $DEBUG; + + my $return = fd_retrieve(\*SOCK) or die "error reading result: $!"; + die $return->{'_error'} if defined $return->{_error} && $return->{_error}; + + warn "returning message to client" + if $DEBUG; + + $return; +} + +=head1 NAME + +FS::SelfService - Freeside self-service API + +=head1 SYNOPSIS + + # password and shell account changes + use FS::SelfService qw(passwd chfn chsh); + + # "my account" functionality + use FS::SelfService qw( login customer_info invoice cancel payment_info process_payment ); + + my $rv = login( { 'username' => $username, + 'domain' => $domain, + 'password' => $password, + } + ); + + if ( $rv->{'error'} ) { + #handle login error... + } else { + #successful login + my $session_id = $rv->{'session_id'}; + } + + my $customer_info = customer_info( { 'session_id' => $session_id } ); + + #payment_info and process_payment are available in 1.5+ only + my $payment_info = payment_info( { 'session_id' => $session_id } ); + + #!!! process_payment example + + #!!! list_pkgs example + + #!!! order_pkg example + + #!!! cancel_pkg example + + # signup functionality + use FS::SelfService qw( signup_info new_customer ); + + my $signup_info = signup_info; + + $rv = new_customer( { + 'first' => $first, + 'last' => $last, + 'company' => $company, + 'address1' => $address1, + 'address2' => $address2, + 'city' => $city, + 'state' => $state, + 'zip' => $zip, + 'country' => $country, + 'daytime' => $daytime, + 'night' => $night, + 'fax' => $fax, + 'payby' => $payby, + 'payinfo' => $payinfo, + 'paycvv' => $paycvv, + 'paystart_month' => $paystart_month + 'paystart_year' => $paystart_year, + 'payissue' => $payissue, + 'payip' => $payip + 'paydate' => $paydate, + 'payname' => $payname, + 'invoicing_list' => $invoicing_list, + 'referral_custnum' => $referral_custnum, + 'pkgpart' => $pkgpart, + 'username' => $username, + '_password' => $password, + 'popnum' => $popnum, + 'agentnum' => $agentnum, + } + ); + + my $error = $rv->{'error'}; + if ( $error eq '_decline' ) { + print_decline(); + } elsif ( $error ) { + reprint_signup(); + } else { + print_success(); + } + +=head1 DESCRIPTION + +Use this API to implement your own client "self-service" module. + +If you just want to customize the look of the existing "self-service" module, +see XXXX instead. + +=head1 PASSWORD, GECOS, SHELL CHANGING FUNCTIONS + +=over 4 + +=item passwd + +=item chfn + +=item chsh + +=back + +=head1 "MY ACCOUNT" FUNCTIONS + +=over 4 + +=item login HASHREF + +Creates a user session. Takes a hash reference as parameter with the +following keys: + +=over 4 + +=item username + +Username + +=item domain + +Domain + +=item password + +Password + +=back + +Returns a hash reference with the following keys: + +=over 4 + +=item error + +Empty on success, or an error message on errors. + +=item session_id + +Session identifier for successful logins + +=back + +=item customer_info HASHREF + +Returns general customer information. + +Takes a hash reference as parameter with a single key: B + +Returns a hash reference with the following keys: + +=over 4 + +=item name + +Customer name + +=item balance + +Balance owed + +=item open + +Array reference of hash references of open inoices. Each hash reference has +the following keys: invnum, date, owed + +=item small_custview + +An HTML fragment containing shipping and billing addresses. + +=item The following fields are also returned + +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 month year invoicing_list postal_invoicing + +=back + +=item edit_info HASHREF + +Takes a hash reference as parameter with any of the following keys: + +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 paycvv payname month year invoicing_list postal_invoicing + +If a field exists, the customer record is updated with the new value of that +field. If a field does not exist, that field is not changed on the customer +record. + +Returns a hash reference with a single key, B, empty on success, or an +error message on errors + +=item invoice HASHREF + +Returns an invoice. Takes a hash reference as parameter with two keys: +session_id and invnum + +Returns a hash reference with the following keys: + +=over 4 + +=item error + +Empty on success, or an error message on errors + +=item invnum + +Invoice number + +=item invoice_text + +Invoice text + +=back + +=item list_invoices HASHREF + +Returns a list of all customer invoices. Takes a hash references with a single +key, session_id. + +Returns a hash reference with the following keys: + +=over 4 + +=item error + +Empty on success, or an error message on errors + +=item invoices + +Reference to array of hash references with the following keys: + +=over 4 + +=item invnum + +Invoice ID + +=item _date + +Invoice date, in UNIX epoch time + +=back + +=back + +=item cancel HASHREF + +Cancels this customer. + +Takes a hash reference as parameter with a single key: B + +Returns a hash reference with a single key, B, which is empty on +success or an error message on errors. + +=item payment_info HASHREF + +Returns information that may be useful in displaying a payment page. + +Takes a hash reference as parameter with a single key: B. + +Returns a hash reference with the following keys: + +=over 4 + +=item error + +Empty on success, or an error message on errors + +=item balance + +Balance owed + +=item payname + +Exact name on credit card (CARD/DCRD) + +=item address1 + +Address line one + +=item address2 + +Address line two + +=item city + +City + +=item state + +State + +=item zip + +Zip or postal code + +=item payby + +Customer's current default payment type. + +=item card_type + +For CARD/DCRD payment types, the card type (Visa card, MasterCard, Discover card, American Express card, etc.) + +=item payinfo + +For CARD/DCRD payment types, the card number + +=item month + +For CARD/DCRD payment types, expiration month + +=item year + +For CARD/DCRD payment types, expiration year + +=item cust_main_county + +County/state/country data - array reference of hash references, each of which has the fields of a cust_main_county record (see L). Note these are not FS::cust_main_county objects, but hash references of columns and values. + +=item states + +Array reference of all states in the current default country. + +=item card_types + +Hash reference of card types; keys are card types, values are the exact strings +passed to the process_payment function + +=item paybatch + +Unique transaction identifier (prevents multiple charges), passed to the +process_payment function + +=back + +=item process_payment HASHREF + +Processes a payment and possible change of address or payment type. Takes a +hash reference as parameter with the following keys: + +=over 4 + +=item session_id + +Session identifier + +=item amount + +Amount + +=item save + +If true, address and card information entered will be saved for subsequent +transactions. + +=item auto + +If true, future credit card payments will be done automatically (sets payby to +CARD). If false, future credit card payments will be done on-demand (sets +payby to DCRD). This option only has meaning if B is set true. + +=item payname + +Name on card + +=item address1 + +Address line one + +=item address2 + +Address line two + +=item city + +City + +=item state + +State + +=item zip + +Zip or postal code + +=item payinfo + +Card number + +=item month + +Card expiration month + +=item year + +Card expiration year + +=item paybatch + +Unique transaction identifier, returned from the payment_info function. +Prevents multiple charges. + +=back + +Returns a hash reference with a single key, B, empty on success, or an +error message on errors + +=item list_pkgs + +Returns package information for this customer. For more detail on services, +see L. + +Takes a hash reference as parameter with a single key: B + +Returns a hash reference containing customer package information. The hash reference contains the following keys: + +=over 4 + +=item custnum + +Customer number + +=item cust_pkg HASHREF + +Array reference of hash references, each of which has the fields of a cust_pkg +record (see L) as well as the fields below. Note these are not +the internal FS:: objects, but hash references of columns and values. + +=over 4 + +=item part_pkg fields + +All fields of part_pkg for this specific cust_pkg (be careful with this +information - it may reveal more about your available packages than you would +like users to know in aggregate) + +=cut + +#XXX pare part_pkg fields down to a more secure subset + +=item part_svc + +An array of hash references indicating information on unprovisioned services +available for provisioning for this specific cust_pkg. Each has the following +keys: + +=over 4 + +=item part_svc fields + +All fields of part_svc (be careful with this information - it may reveal more +about your available packages than you would like users to know in aggregate) + +=cut + +#XXX pare part_svc fields down to a more secure subset + +=back + +=item cust_svc + +An array of hash references indicating information on the customer services +already provisioned for this specific cust_pkg. Each has the following keys: + +=over 4 + +=item label + +Array reference with three elements: + +=over 4 + +=item Name of this service + +=item Meaningful user-specific identifier for the service (i.e. username, domain or mail alias) + +=item Table name of this service + +=back + +=item svcnum + +Primary key for this service + +=item svcpart + +Service definition (part_pkg) + +=item pkgnum + +Customer package (cust_pkg) + +=item overlimit + +Blank if the service is not over limit, or the date the service exceeded its usage limit (as a UNIX timestamp). + +=back + +=back + +=item error + +Empty on success, or an error message on errors. + +=back + +=item list_svcs + +Returns service information for this customer. + +Takes a hash reference as parameter with a single key: B + +Returns a hash reference containing customer package information. The hash reference contains the following keys: + +=over 4 + +=item custnum + +Customer number + +=item svcs + +An array of hash references indicating information on all of this customer's +services. Each has the following keys: + +=over 4 + +=item svcnum + +Primary key for this service + +=item label + +Name of this service + +=item value + +Meaningful user-specific identifier for the service (i.e. username, domain, or +mail alias). + +=back + +Account (svc_acct) services also have the following keys: + +=item username + +Username + +=item email + +username@domain + +=item seconds + +Seconds remaining + +=item upbytes + +Upload bytes remaining + +=item downbytes + +Download bytes remaining + +=item totalbytes + +Total bytes remaining + +=item recharge_amount + +Cost of a recharge + +=item recharge_seconds + +Number of seconds gained by recharge + +=item recharge_upbytes + +Number of upload bytes gained by recharge + +=item recharge_downbytes + +Number of download bytes gained by recharge + +=item recharge_totalbytes + +Number of total bytes gained by recharge + +=back + +=back + +=item order_pkg + +Orders a package for this customer. + +Takes a hash reference as parameter with the following keys: + +=over 4 + +=item session_id + +Session identifier + +=item pkgpart + +pkgpart of package to order + +=item svcpart + +optional svcpart, required only if the package definition does not contain +one svc_acct service definition with quantity 1 (it may contain others with +quantity >1) + +=item username + +Username + +=item _password + +Password + +=item sec_phrase + +Optional security phrase + +=item popnum + +Optional Access number number + +=back + +Returns a hash reference with a single key, B, empty on success, or an +error message on errors. The special error '_decline' is returned for +declined transactions. + +=item cancel_pkg + +Cancels a package for this customer. + +Takes a hash reference as parameter with the following keys: + +=over 4 + +=item session_id + +Session identifier + +=item pkgpart + +pkgpart of package to cancel + +=back + +Returns a hash reference with a single key, B, empty on success, or an +error message on errors. + +=back + +=head1 SIGNUP FUNCTIONS + +=over 4 + +=item signup_info HASHREF + +Takes a hash reference as parameter with the following keys: + +=over 4 + +=item session_id - Optional agent/reseller interface session + +=back + +Returns a hash reference containing information that may be useful in +displaying a signup page. The hash reference contains the following keys: + +=over 4 + +=item cust_main_county + +County/state/country data - array reference of hash references, each of which has the fields of a cust_main_county record (see L). Note these are not FS::cust_main_county objects, but hash references of columns and values. + +=item part_pkg + +Available packages - array reference of hash references, each of which has the fields of a part_pkg record (see L). Each hash reference also has an additional 'payby' field containing an array reference of acceptable payment types specific to this package (see below and L). Note these are not FS::part_pkg objects, but hash references of columns and values. Requires the 'signup_server-default_agentnum' configuration value to be set, or +an agentnum specified explicitly via reseller interface session_id in the +options. + +=item agent + +Array reference of hash references, each of which has the fields of an agent record (see L). Note these are not FS::agent objects, but hash references of columns and values. + +=item agentnum2part_pkg + +Hash reference; keys are agentnums, values are array references of available packages for that agent, in the same format as the part_pkg arrayref above. + +=item svc_acct_pop + +Access numbers - array reference of hash references, each of which has the fields of an svc_acct_pop record (see L). Note these are not FS::svc_acct_pop objects, but hash references of columns and values. + +=item security_phrase + +True if the "security_phrase" feature is enabled + +=item payby + +Array reference of acceptable payment types for signup + +=over 4 + +=item CARD + +credit card - automatic + +=item DCRD + +credit card - on-demand - version 1.5+ only + +=item CHEK + +electronic check - automatic + +=item DCHK + +electronic check - on-demand - version 1.5+ only + +=item LECB + +Phone bill billing + +=item BILL + +billing, not recommended for signups + +=item COMP + +free, definitely not recommended for signups + +=item PREPAY + +special billing type: applies a credit (see FS::prepay_credit) and sets billing type to BILL + +=back + +=item cvv_enabled + +True if CVV features are available (1.5+ or 1.4.2 with CVV schema patch) + +=item msgcat + +Hash reference of message catalog values, to support error message customization. Currently available keys are: passwords_dont_match, invalid_card, unknown_card_type, and not_a (as in "Not a Discover card"). Values are configured in the web interface under "View/Edit message catalog". + +=item statedefault + +Default state + +=item countrydefault + +Default country + +=back + +=item new_customer HASHREF + +Creates a new customer. Takes a hash reference as parameter with the +following keys: + +=over 4 + +=item first + +first name (required) + +=item last + +last name (required) + +=item ss + +(not typically collected; mostly used for ACH transactions) + +=item company + +Company name + +=item address1 (required) + +Address line one + +=item address2 + +Address line two + +=item city (required) + +City + +=item county + +County + +=item state (required) + +State + +=item zip (required) + +Zip or postal code + +=item daytime + +Daytime phone number + +=item night + +Evening phone number + +=item fax + +Fax number + +=item payby + +CARD, DCRD, CHEK, DCHK, LECB, BILL, COMP or PREPAY (see L (required) + +=item payinfo + +Card number for CARD/DCRD, account_number@aba_number for CHEK/DCHK, prepaid "pin" for PREPAY, purchase order number for BILL + +=item paycvv + +Credit card CVV2 number (1.5+ or 1.4.2 with CVV schema patch) + +=item paydate + +Expiration date for CARD/DCRD + +=item payname + +Exact name on credit card for CARD/DCRD, bank name for CHEK/DCHK + +=item invoicing_list + +comma-separated list of email addresses for email invoices. The special value 'POST' is used to designate postal invoicing (it may be specified alone or in addition to email addresses), + +=item referral_custnum + +referring customer number + +=item pkgpart + +pkgpart of initial package + +=item username + +Username + +=item _password + +Password + +=item sec_phrase + +Security phrase + +=item popnum + +Access number (index, not the literal number) + +=item agentnum + +Agent number + +=back + +Returns a hash reference with the following keys: + +=over 4 + +=item error + +Empty on success, or an error message on errors. The special error '_decline' is returned for declined transactions; other error messages should be suitable for display to the user (and are customizable in under Configuration | View/Edit message catalog) + +=back + +=item regionselector HASHREF | LIST + +Takes as input a hashref or list of key/value pairs with the following keys: + +=over 4 + +=item selected_county + +Currently selected county + +=item selected_state + +Currently selected state + +=item selected_country + +Currently selected country + +=item prefix + +Specify a unique prefix string if you intend to use the HTML output multiple time son one page. + +=item onchange + +Specify a javascript subroutine to call on changes + +=item default_state + +Default state + +=item default_country + +Default country + +=item locales + +An arrayref of hash references specifying regions. Normally you can just pass the value of the I field returned by B. + +=back + +Returns a list consisting of three HTML fragments for county selection, +state selection and country selection, respectively. + +=cut + +#false laziness w/FS::cust_main_county (this is currently the "newest" version) +sub regionselector { + my $param; + if ( ref($_[0]) ) { + $param = shift; + } else { + $param = { @_ }; + } + $param->{'selected_country'} ||= $param->{'default_country'}; + $param->{'selected_state'} ||= $param->{'default_state'}; + + my $prefix = exists($param->{'prefix'}) ? $param->{'prefix'} : ''; + + my $countyflag = 0; + + my %cust_main_county; + +# unless ( @cust_main_county ) { #cache + #@cust_main_county = qsearch('cust_main_county', {} ); + #foreach my $c ( @cust_main_county ) { + foreach my $c ( @{ $param->{'locales'} } ) { + #$countyflag=1 if $c->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; + $cust_main_county{$c->{country}}{$c->{state}}{$c->{county}} = 1; + } +# } + $countyflag=1 if $param->{selected_county}; + + my $script_html = < + 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 $text = $state || '(n/a)'; + $script_html .= qq!opt(what.form.${prefix}state, "$state", "$text");\n!; + } + $script_html .= "}\n"; + } + + $script_html .= <= 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 + + my $county_html = $script_html; + if ( $countyflag ) { + $county_html .= qq!'; + } else { + $county_html .= + qq!!; + } + + my $state_html = qq!'; + + $state_html .= ''; + + my $country_html = qq!'; + + ($county_html, $state_html, $country_html); + +} + +#=item expselect HASHREF | LIST +# +#Takes as input a hashref or list of key/value pairs with the following keys: +# +#=over 4 +# +#=item prefix - Specify a unique prefix string if you intend to use the HTML output multiple time son one page. +# +#=item date - current date, in yyyy-mm-dd or m-d-yyyy format +# +#=back + +=item expselect PREFIX [ DATE ] + +Takes as input a unique prefix string and the current expiration date, in +yyyy-mm-dd or m-d-yyyy format + +Returns an HTML fragments for expiration date selection. + +=cut + +sub expselect { + #my $param; + #if ( ref($_[0]) ) { + # $param = shift; + #} else { + # $param = { @_ }; + #my $prefix = $param->{'prefix'}; + #my $prefix = exists($param->{'prefix'}) ? $param->{'prefix'} : ''; + #my $date = exists($param->{'date'}) ? $param->{'date'} : ''; + my $prefix = shift; + my $date = scalar(@_) ? shift : ''; + + my( $m, $y ) = ( 0, 0 ); + if ( $date =~ /^(\d{4})-(\d{2})-\d{2}$/ ) { #PostgreSQL date format + ( $m, $y ) = ( $2, $1 ); + } elsif ( $date =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) { + ( $m, $y ) = ( $1, $3 ); + } + my $return = qq!!; + my @t = localtime; + my $thisYear = $t[5] + 1900; + for ( ($thisYear > $y && $y > 0 ? $y : $thisYear) .. ($thisYear+10) ) { + $return .= qq!


    +powered by freeside + + diff --git a/fs_selfservice/FS-SelfService/cgi/agent.cgi b/fs_selfservice/FS-SelfService/cgi/agent.cgi new file mode 100644 index 000000000..6e8de619a --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/agent.cgi @@ -0,0 +1,458 @@ +#!/usr/bin/perl -T +#!/usr/bin/perl -Tw + +#some false laziness w/selfservice.cgi + +use strict; +use vars qw($DEBUG $me $cgi $session_id $form_max $template_dir); +use subs qw(do_template); +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use Business::CreditCard; +use Text::Template; +#use HTML::Entities; +use FS::SelfService qw( agent_login agent_logout agent_info + agent_list_customers + signup_info new_customer + customer_info list_pkgs order_pkg + part_svc_info provision_acct provision_external + unprovision_svc + ); + +$DEBUG = 0; +$me = 'agent.cgi:'; + +$template_dir = '.'; + +$form_max = 255; + +warn "$me starting\n" if $DEBUG; + +warn "$me initializing CGI\n" if $DEBUG; +$cgi = new CGI; + +unless ( defined $cgi->param('session') ) { + warn "$me no session defined, sending login page\n" if $DEBUG; + do_template('agent_login',{}); + exit; +} + +if ( $cgi->param('session') eq 'login' ) { + + warn "$me processing login\n" if $DEBUG; + + $cgi->param('username') =~ /^\s*([a-z0-9_\-\.\&]{0,$form_max})\s*$/i + or die "illegal username"; + my $username = $1; + + $cgi->param('password') =~ /^(.{0,$form_max})$/ + or die "illegal password"; + my $password = $1; + + my $rv = agent_login( + 'username' => $username, + 'password' => $password, + ); + if ( $rv->{error} ) { + do_template('agent_login', { + 'error' => $rv->{error}, + 'username' => $username, + } ); + exit; + } else { + $cgi->param('session' => $rv->{session_id} ); + $cgi->param('action' => 'agent_main' ); + } +} + +$session_id = $cgi->param('session'); + +warn "$me checking action\n" if $DEBUG; +$cgi->param('action') =~ + /^(agent_main|signup|process_signup|list_customers|view_customer|agent_provision|provision_svc|process_svc_acct|process_svc_external|delete_svc|agent_order_pkg|process_order_pkg|logout)$/ + or die "unknown action ". $cgi->param('action'); +my $action = $1; + +warn "$me running $action\n" if $DEBUG; +my $result = eval "&$action();"; +die $@ if $@; + +if ( $result->{error} eq "Can't resume session" ) { #ick + do_template('agent_login',{}); + exit; +} + +warn "$me processing template $action\n" if $DEBUG; +do_template($action, { + 'session_id' => $session_id, + %{$result} +}); +warn "$me done processing template $action\n" if $DEBUG; + +#-- + +sub logout { + $action = 'agent_logout'; + agent_logout( 'session_id' => $session_id ); +} + +sub agent_main { agent_info( 'session_id' => $session_id ); } + +sub signup { signup_info( 'session_id' => $session_id ); } + +sub process_signup { + + my $init_data = signup_info( 'session_id' => $session_id ); + if ( $init_data->{'error'} ) { + if ( $init_data->{'error'} eq "Can't resume session" ) { #ick + do_template('agent_login',{}); + exit; + } else { #? + die $init_data->{'error'}; + } + } + + my $error = ''; + + #false laziness w/signup.cgi, identical except for agentnum vs session_id + my $payby = $cgi->param('payby'); + if ( $payby eq 'CHEK' || $payby eq 'DCHK' ) { + #$payinfo = join('@', map { $cgi->param( $payby. "_payinfo$_" ) } (1,2) ); + $cgi->param('payinfo' => $cgi->param($payby. '_payinfo1'). '@'. + $cgi->param($payby. '_payinfo2') + ); + } else { + $cgi->param('payinfo' => $cgi->param( $payby. '_payinfo' ) ); + } + $cgi->param('paydate' => $cgi->param( $payby. '_month' ). '-'. + $cgi->param( $payby. '_year' ) + ); + $cgi->param('payname' => $cgi->param( $payby. '_payname' ) ); + $cgi->param('paycvv' => defined $cgi->param( $payby. '_paycvv' ) + ? $cgi->param( $payby. '_paycvv' ) + : '' + ); + + if ( $cgi->param('invoicing_list') ) { + $cgi->param('invoicing_list' => $cgi->param('invoicing_list'). ', POST') + if $cgi->param('invoicing_list_POST'); + } else { + $cgi->param('invoicing_list' => 'POST' ); + } + + if ( $cgi->param('_password') ne $cgi->param('_password2') ) { + $error = $init_data->{msgcat}{passwords_dont_match}; #msgcat + $cgi->param('_password', ''); + $cgi->param('_password2', ''); + } + + if ( $payby =~ /^(CARD|DCRD)$/ && $cgi->param('CARD_type') ) { + my $payinfo = $cgi->param('payinfo'); + $payinfo =~ s/\D//g; + + $payinfo =~ /^(\d{13,16})$/ + or $error ||= $init_data->{msgcat}{invalid_card}; #. $self->payinfo; + $payinfo = $1; + validate($payinfo) + or $error ||= $init_data->{msgcat}{invalid_card}; #. $self->payinfo; + cardtype($payinfo) eq $cgi->param('CARD_type') + or $error ||= $init_data->{msgcat}{not_a}. $cgi->param('CARD_type'); + } + + unless ( $error ) { + my $rv = new_customer ( { + 'session_id' => $session_id, + map { $_ => scalar($cgi->param($_)) } + qw( last first ss company + address1 address2 city county state zip country + daytime night fax + + ship_last ship_first 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 invoicing_list + referral_custnum promo_code reg_code + pkgpart username sec_phrase _password popnum refnum + ), + grep { /^snarf_/ } $cgi->param + } ); + $error = $rv->{'error'}; + } + #eslaf + + if ( $error ) { + $action = 'signup'; + my $r = { + $cgi->Vars, + %{$init_data}, + 'error' => $error, + }; + #warn join('\n', map "$_ => $r->{$_}", keys %$r )."\n"; + $r; + } else { + $action = 'agent_main'; + my $agent_info = agent_info( 'session_id' => $session_id ); + $agent_info->{'message'} = 'Signup successful'; + $agent_info; + } + +} + +sub list_customers { + + my $results = + agent_list_customers( 'session_id' => $session_id, + map { $_ => $cgi->param($_) } + grep defined($cgi->param($_)), + qw(prospect active susp cancel), + 'search', + ); + + if ( scalar( @{$results->{'customers'}} ) == 1 ) { + $action = 'view_customer'; + customer_info ( + 'agent_session_id' => $session_id, + 'custnum' => $results->{'customers'}[0]{'custnum'}, + ); + } else { + $results; + } + +} + +sub view_customer { + + #my $init_data = signup_info( 'session_id' => $session_id ); + #if ( $init_data->{'error'} ) { + # if ( $init_data->{'error'} eq "Can't resume session" ) { #ick + # do_template('agent_login',{}); + # exit; + # } else { #? + # die $init_data->{'error'}; + # } + #} + # + #my $customer_info = + customer_info ( + 'agent_session_id' => $session_id, + 'custnum' => $cgi->param('custnum'), + ); + # + #return { + # ( map { $_ => $init_data->{$_} } + # qw( part_pkg security_phrase svc_acct_pop ), + # ), + # %$customer_info, + #}; +} + +sub agent_order_pkg { + + my $init_data = signup_info( 'session_id' => $session_id ); + if ( $init_data->{'error'} ) { + if ( $init_data->{'error'} eq "Can't resume session" ) { #ick + do_template('agent_login',{}); + exit; + } else { #? + die $init_data->{'error'}; + } + } + + my $customer_info = customer_info ( + 'agent_session_id' => $session_id, + 'custnum' => $cgi->param('custnum'), + ); + + return { + ( map { $_ => $init_data->{$_} } + qw( part_pkg security_phrase svc_acct_pop ), + ), + %$customer_info, + }; + +} + +sub agent_provision { + my $result = list_pkgs( + 'agent_session_id' => $session_id, + 'custnum' => $cgi->param('custnum'), + ); + die $result->{'error'} if exists $result->{'error'} && $result->{'error'}; + $result; +} + +sub provision_svc { + + my $result = part_svc_info( + 'agent_session_id' => $session_id, + map { $_ => $cgi->param($_) } qw( pkgnum svcpart custnum ), + ); + die $result->{'error'} if exists $result->{'error'} && $result->{'error'}; + + $result->{'svcdb'} =~ /^svc_(.*)$/ + #or return { 'error' => 'Unknown svcdb '. $result->{'svcdb'} }; + or die 'Unknown svcdb '. $result->{'svcdb'}; + $action .= "_$1"; + $action = "agent_$action"; + + $result; +} + +sub process_svc_acct { + + my $result = provision_acct ( + 'agent_session_id' => $session_id, + map { $_ => $cgi->param($_) } qw( + custnum pkgnum svcpart username _password _password2 sec_phrase popnum ) + ); + + if ( exists $result->{'error'} && $result->{'error'} ) { + #warn "$result $result->{'error'}"; + $action = 'provision_svc_acct'; + $action = "agent_$action"; + return { + $cgi->Vars, + %{ part_svc_info( 'agent_session_id' => $session_id, + map { $_ => $cgi->param($_) } qw(pkgnum svcpart custnum) + ) + }, + 'error' => $result->{'error'}, + }; + } else { + #warn "$result $result->{'error'}"; + $action = 'agent_provision'; + return { + %{agent_provision()}, + 'message' => $result->{'svc'}. ' setup successfully.', + }; + } + +} + +sub process_svc_external { + + my $result = provision_external ( + 'agent_session_id' => $session_id, + map { $_ => $cgi->param($_) } qw( custnum pkgnum svcpart ) + ); + + #warn "$result $result->{'error'}"; + $action = 'agent_provision'; + return { + %{agent_provision()}, + 'message' => $result->{'error'} + ? ''. $result->{'error'}. '' + : $result->{'svc'}. ' setup successfully'. + ': serial number '. + sprintf('%010d', $result->{'id'}). '-'. $result->{'title'} + }; + +} + +sub delete_svc { + my $result = unprovision_svc( + 'agent_session_id' => $session_id, + 'custnum' => $cgi->param('custnum'), + 'svcnum' => $cgi->param('svcnum'), + ); + + $action = 'agent_provision'; + + return { + %{agent_provision()}, + 'message' => $result->{'error'} + ? ''. $result->{'error'}. '' + : $result->{'svc'}. ' removed.' + }; + +} + +sub process_order_pkg { + + my $results = ''; + + unless ( length($cgi->param('_password')) ) { + my $init_data = signup_info( 'session_id' => $session_id ); + #die $init_data->{'error'} if $init_data->{'error'}; + $results = { 'error' => $init_data->{msgcat}{empty_password} }; + } + if ( $cgi->param('_password') ne $cgi->param('_password2') ) { + my $init_data = signup_info( 'session_id' => $session_id ); + $results = { 'error' => $init_data->{msgcat}{passwords_dont_match} }; + $cgi->param('_password', ''); + $cgi->param('_password2', ''); + } + + $results ||= order_pkg ( + 'agent_session_id' => $session_id, + map { $_ => $cgi->param($_) } + qw( custnum pkgpart username _password _password2 sec_phrase popnum ) + ); + + if ( $results->{'error'} ) { + $action = 'agent_order_pkg'; + return { + $cgi->Vars, + %{agent_order_pkg()}, + #'message' => ''. $results->{'error'}. '', + 'error' => ''. $results->{'error'}. '', + }; + } else { + $action = 'view_customer'; + #$cgi->delete( grep { $_ ne 'custnum' } $cgi->param ); + return { + %{view_customer()}, + 'message' => 'Package order successful.', + }; + } + +} + +#-- + +sub do_template { + my $name = shift; + my $fill_in = shift; + #warn join(' / ', map { "$_=>".$fill_in->{$_} } keys %$fill_in). "\n"; + + $cgi->delete_all(); + $fill_in->{'selfurl'} = $cgi->self_url; #OLD + $fill_in->{'self_url'} = $cgi->self_url; + $fill_in->{'cgi'} = \$cgi; + + my $template = new Text::Template( TYPE => 'FILE', + SOURCE => "$template_dir/$name.html", + DELIMITERS => [ '<%=', '%>' ], + UNTAINT => 1, ) + or die $Text::Template::ERROR; + + local $^W = 0; + print $cgi->header( '-expires' => 'now' ), + $template->fill_in( PACKAGE => 'FS::SelfService::_agentcgi', + HASH => $fill_in + ); +} + +package FS::SelfService::_agentcgi; + +use HTML::Entities; +use FS::SelfService qw(regionselector expselect popselector); + +#false laziness w/selfservice.cgi +sub include { + my $name = shift; + my $template = new Text::Template( TYPE => 'FILE', + SOURCE => "$main::template_dir/$name.html", + DELIMITERS => [ '<%=', '%>' ], + UNTAINT => 1, + ) + or die $Text::Template::ERROR; + + $template->fill_in( PACKAGE => 'FS::SelfService::_agentcgi', + #HASH => $fill_in + ); + +} + diff --git a/fs_selfservice/FS-SelfService/cgi/agent_customer_menu.html b/fs_selfservice/FS-SelfService/cgi/agent_customer_menu.html new file mode 100644 index 000000000..603fc0bd2 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/agent_customer_menu.html @@ -0,0 +1,7 @@ +<%= $url = "$selfurl?session=$session_id;custnum=$custnum;action="; ''; %> + +Setup services

    +Purchase additional package

    + + + diff --git a/fs_selfservice/FS-SelfService/cgi/agent_delete_svc.html b/fs_selfservice/FS-SelfService/cgi/agent_delete_svc.html new file mode 100644 index 000000000..7a2b75071 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/agent_delete_svc.html @@ -0,0 +1,19 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + +<%= $small_custview %> +
    +<%= if ( $error ) { + + $OUT .= qq!Error: $error!; +} else { + $OUT .= "$svc removed."; +} %> + + +
    +powered by freeside + + diff --git a/fs_selfservice/FS-SelfService/cgi/agent_login.html b/fs_selfservice/FS-SelfService/cgi/agent_login.html new file mode 100644 index 000000000..4b0778ec5 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/agent_login.html @@ -0,0 +1,22 @@ +Reseller Login +Reseller Login

    +<%= $error %> +
    + + + + + + + + + + +
    Username + +
    Password + +
    +

    +
    + diff --git a/fs_selfservice/FS-SelfService/cgi/agent_logout.html b/fs_selfservice/FS-SelfService/cgi/agent_logout.html new file mode 100644 index 000000000..98094679a --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/agent_logout.html @@ -0,0 +1,5 @@ +Reseller +Reseller

    +You have been logged out. + + diff --git a/fs_selfservice/FS-SelfService/cgi/agent_main.html b/fs_selfservice/FS-SelfService/cgi/agent_main.html new file mode 100644 index 000000000..9dd338382 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/agent_main.html @@ -0,0 +1,37 @@ +Reseller +Reseller

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> + +<%= include('agent_menu') %> +
    + +<%= $message + ? "$message" + : "Hello $agent!" +%>

    + + + +
    Customer summary
    + + <%= $num_prospect %> + <%= $num_prospect ? qq!! : '' %>prospects + +
    <%= $num_active %> + <%= $num_active ? qq!! : '' %>active + +
    <%= $num_susp %> + <%= $num_susp ? qq!! : '' %>suspended + +
    <%= $num_cancel %> + <%= $num_cancel ? qq!! : '' %>cancelled + +
    + +
    +
    +powered by freeside + + + + diff --git a/fs_selfservice/FS-SelfService/cgi/agent_menu.html b/fs_selfservice/FS-SelfService/cgi/agent_menu.html new file mode 100644 index 000000000..84a295304 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/agent_menu.html @@ -0,0 +1,15 @@ +<%= $url = "$selfurl?session=$session_id;action="; ''; %> + + +Overview

    +New customer

    +
    + + +
    +cust #, last name, or company
    +
    +
    +Logout

    + + diff --git a/fs_selfservice/FS-SelfService/cgi/agent_order_pkg.html b/fs_selfservice/FS-SelfService/cgi/agent_order_pkg.html new file mode 100644 index 000000000..0a665c99e --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/agent_order_pkg.html @@ -0,0 +1,19 @@ +Reseller +Reseller

    +<%= $url = "$selfurl?session=$session_id;custnum=$custnum;action="; ''; %> + +<%= include('agent_menu') %> +
    +<%= $small_custview %> +
    + + +<%= include('agent_customer_menu') %> +
    +<%= include('order_pkg') %> +
    + +
    +
    +powered by freeside + diff --git a/fs_selfservice/FS-SelfService/cgi/agent_provision.html b/fs_selfservice/FS-SelfService/cgi/agent_provision.html new file mode 100644 index 000000000..8770e2f9e --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/agent_provision.html @@ -0,0 +1,25 @@ +Reseller +Reseller

    +<%= $url = "$selfurl?session=$session_id;custnum=$custnum;action="; ''; %> + +<%= include('agent_menu') %> +
    + +<%= $message + ? "$message

    " + : '' +%> + +<%= $small_custview %> +
    + + +<%= include('agent_customer_menu') %> +
    +<%= include('provision_list') %> +
    + +
    +
    +powered by freeside + diff --git a/fs_selfservice/FS-SelfService/cgi/agent_provision_svc_acct.html b/fs_selfservice/FS-SelfService/cgi/agent_provision_svc_acct.html new file mode 100644 index 000000000..8d299cdc5 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/agent_provision_svc_acct.html @@ -0,0 +1,19 @@ +Reseller +Reseller

    +<%= $url = "$selfurl?session=$session_id;custnum=$custnum;action="; ''; %> + +<%= include('agent_menu') %> +
    +<%= $small_custview %> +
    + +<%= include('agent_customer_menu') %> +
    +<%= include('svc_acct') %> +
    + +
    +
    +powered by freeside + + diff --git a/fs_selfservice/FS-SelfService/cgi/bill.html b/fs_selfservice/FS-SelfService/cgi/bill.html new file mode 100644 index 000000000..bbdf1f210 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/bill.html @@ -0,0 +1,7 @@ + + P.O. number + + + Attention + + diff --git a/fs_selfservice/FS-SelfService/cgi/card.html b/fs_selfservice/FS-SelfService/cgi/card.html new file mode 100644 index 000000000..cf6d20d8d --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/card.html @@ -0,0 +1,73 @@ + + Card number + + + + + + + + + +
    + Exp. + + / + +
    + + +<%= + if ( $withcvv ) { + $OUT .= qq!!; + $OUT .= qq!CVV2 (help)!; + $OUT .= qq!!; + $OUT .= qq!!; + } + ''; +%> + + Exact name on card + + + Card billing address + + + + + Address line 2 + + + + + City + + + + + + + + + +
    + + State + + Zip + +
    + + diff --git a/fs_selfservice/FS-SelfService/cgi/change_bill.html b/fs_selfservice/FS-SelfService/cgi/change_bill.html new file mode 100755 index 000000000..0bc47d069 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/change_bill.html @@ -0,0 +1,25 @@ +MyAccount + +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + +Edit billing address

    +<%= if ( $error ) { + $OUT .= qq!Error: $error

    !; +} ''; %> + +
    + + + + +<%= $r=qq!* !; include('contact') %> + +"> +
    + +
    +
    +powered by freeside + diff --git a/fs_selfservice/FS-SelfService/cgi/change_password.html b/fs_selfservice/FS-SelfService/cgi/change_password.html new file mode 100644 index 000000000..af7b45313 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/change_password.html @@ -0,0 +1,53 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + + +Change password

    + +<%= if ( $error ) { + $OUT .= qq!$error

    !; +} ''; %> + +
    + + + + + + + + + + + + + + + + + + + + +
    Change password for account: + +
    New password:
    Re-enter new password:
    +
    + + + +
    + + +
    +powered by freeside + diff --git a/fs_selfservice/FS-SelfService/cgi/change_pay.html b/fs_selfservice/FS-SelfService/cgi/change_pay.html new file mode 100644 index 000000000..d26abfa7a --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/change_pay.html @@ -0,0 +1,75 @@ +MyAccount + + +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + +Change payment information

    +<%= if ( $error ) { + $OUT .= qq!Error: $error

    !; + } ''; %> + +
    +<%= + use Tie::IxHash; + use HTML::Widgets::SelectLayers; + + my $preauto = '). + qq(). + qq(
    ). + qq( ). + qq(); + + + my %paybychecked = ( + 'BILL' => include('bill'), + 'CARD' => include('card')."$preauto CHECKED $postauto", + 'DCRD' => include('card')."$preauto $postauto", + 'CHEK' => include('check')."$preauto CHECKED $postauto", + 'DCHK' => include('check')."$preauto $postauto", + ); + my %payby_index = ( 'CARD' => qq/Credit Card/, + 'DCRD' => qq/Credit Card/, + 'CHEK' => qq/Check/, + 'DCHK' => qq/Check/, + 'LECB' => qq/Phone Bill Billing/, + 'BILL' => qq/Billing/, + 'COMP' => qq/Complimentary/, + 'PREPAY' => qq/Prepaid Card/, + ); + tie my %options, 'Tie::IxHash', (); + foreach my $payby_option ( @paybys ) { + $options{$payby_option} = $payby_index{$payby_option}; + } + $options{$payby} = $payby_index{$payby} + unless exists($options{$payby}); + + HTML::Widgets::SelectLayers->new( + options => \%options, + selected_layer => $payby, +# form_name => 'dummy', +# form_action => 'dummy.cgi', + layer_callback => sub { my $layer = shift; return ''.$paybychecked{$layer}.qq!$tail!; }, + )->html; + +%> +
    +
    +powered by freeside + diff --git a/fs_selfservice/FS-SelfService/cgi/change_pkg.html b/fs_selfservice/FS-SelfService/cgi/change_pkg.html new file mode 100644 index 000000000..a841308a5 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/change_pkg.html @@ -0,0 +1,37 @@ + +Purchase replacement package for "<%= $pkg; %>"

    +<%= if ( $error ) { + $OUT .= qq!$error

    !; +} ''; %> + + + + + + + + + +
    + +
    + diff --git a/fs_selfservice/FS-SelfService/cgi/change_ship.html b/fs_selfservice/FS-SelfService/cgi/change_ship.html new file mode 100755 index 000000000..1a3b85d6d --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/change_ship.html @@ -0,0 +1,104 @@ +MyAccount + +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + +Edit service address

    +<%= if ( $error ) { + $OUT .= qq!Error: $error

    !; +} ''; %> + +
    + + + + +<%= + foreach ( + qw( last first company address1 address2 city county state zip country + daytime night fax ) + ) { + $OUT .= qq!!; + }; + ''; +%> + +(param('same') eq 'Y') ? 'CHECKED' : '' %> + >same as billing address) +<%= $r=qq!* !; + if (!$ship_last || $cgi->param('same') eq 'Y') { + $disabled = 'DISABLED STYLE="background-color: #dddddd"'; + foreach ( qw( last first company address1 address2 city county state + zip country daytime night fax ) + ) { + ${"ship_$_"} = ${$_}; + } + }else{ + $disabled = ''; + } + $pre = 'ship_'; + include('contact'); +%> + +"> +
    + +
    +
    +powered by freeside + diff --git a/fs_selfservice/FS-SelfService/cgi/check.html b/fs_selfservice/FS-SelfService/cgi/check.html new file mode 100644 index 000000000..68753fe08 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/check.html @@ -0,0 +1,54 @@ + + Account type + + + + + Account number + + + ABA/Routing number + + + Bank name + + + <%= + $OUT = ''; + if ($show_paystate) { + $OUT .= qq!Bank state'; + } + %> + <%= + $OUT = ''; + if ($show_ss) { + $OUT .= 'Account holder
    Social '; + $OUT .= 'security or tax ID #'; + $OUT .= qq!!; + $OUT .= ''; + } + %> + <%= + $OUT = ''; + if ($show_stateid) { + $OUT .= ''; + $OUT .= qq!Account holder
    $stateid_label!; + $OUT .= qq!!; + $OUT .= qq!$stateid_state_label!; + $OUT .= ''; + } + %> + diff --git a/fs_selfservice/FS-SelfService/cgi/contact.html b/fs_selfservice/FS-SelfService/cgi/contact.html new file mode 100644 index 000000000..20c15df78 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/contact.html @@ -0,0 +1,135 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + <%= + ($county_html, $state_html, $country_html) = + FS::SelfService::regionselector( { + prefix => $pre, + selected_county => ${$pre.'county'}, + selected_state => ${$pre.'state'}, + selected_country => ${$pre.'country'}, + default_state => $statedefault, + default_country => $countrydefault, + locales => \@cust_main_county, + } ); + + $OUT .= qq!!; + $OUT .= qq!!; + $OUT .= qq!!; + $OUT .= qq!!; + $OUT .= qq!!; + $OUT .= qq!!; + $OUT .= qq!!; + $OUT .= qq!!; + %> + + + + + + + + + + + + + + + + + + + +
    <%=$r%>Contact name
    (last, first)
    + > , + > +
    Company + > +
    <%=$r%>Address + > +
    + <%= + my $style = + ( $disabled + || !$require_address2 + || ( !$pre && $ship_last ) + ) + ? 'visibility:hidden' + : ''; + + $OUT .= qq!* Unit #!; + %> + + > +
    <%=$r%>City + > + ${r}State/County$county_html $state_html${r}Zip
    ${r}Country$country_html
    Day Phone + > +
    Night Phone + > +
    Fax + > +
    +<%=$r%>required fields
    + + diff --git a/fs_selfservice/FS-SelfService/cgi/cust_bill-logo.cgi b/fs_selfservice/FS-SelfService/cgi/cust_bill-logo.cgi new file mode 100644 index 000000000..5f344a32e --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/cust_bill-logo.cgi @@ -0,0 +1,19 @@ +#!/usr/bin/perl -T +#!/usr/bin/perl -Tw + +use strict; +use CGI; +use FS::SelfService qw( invoice_logo ); + +my $cgi = new CGI; + +my($query) = $cgi->keywords; +$query =~ /^([^\.\/]*)$/ or '' =~ /^()$/; +my $templatename = $1; +my $hashref = invoice_logo('templatename' => $templatename); + +print $cgi->header( '-type' => $hashref->{'content_type'}, + '-expires' => 'now', + ). + $hashref->{'logo'}; + diff --git a/fs_selfservice/FS-SelfService/cgi/customer_change_pkg.html b/fs_selfservice/FS-SelfService/cgi/customer_change_pkg.html new file mode 100644 index 000000000..d08ab9679 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/customer_change_pkg.html @@ -0,0 +1,10 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + +<%= include('change_pkg') %> + +
    +powered by freeside + diff --git a/fs_selfservice/FS-SelfService/cgi/customer_order_pkg.html b/fs_selfservice/FS-SelfService/cgi/customer_order_pkg.html new file mode 100755 index 000000000..c01b6b384 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/customer_order_pkg.html @@ -0,0 +1,10 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + +<%= include('order_pkg') %> + +
    +powered by freeside + diff --git a/fs_selfservice/FS-SelfService/cgi/cvv2.html b/fs_selfservice/FS-SelfService/cgi/cvv2.html new file mode 100644 index 000000000..b178c8513 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/cvv2.html @@ -0,0 +1,25 @@ + + + + CVV2 information + + + + The CVV2 number (also called CVC2 or CID) is a three- or four-digit + security code used to reduce credit card fraud.

    + + + + + + + + +
    Visa / MasterCard / DiscoverAmerican Express
    + Visa/MasterCard/Discover + + American Express +
    +
    (close window)
    + + diff --git a/fs_selfservice/FS-SelfService/cgi/cvv2.png b/fs_selfservice/FS-SelfService/cgi/cvv2.png new file mode 100644 index 000000000..4610dcbe6 Binary files /dev/null and b/fs_selfservice/FS-SelfService/cgi/cvv2.png differ diff --git a/fs_selfservice/FS-SelfService/cgi/cvv2_amex.png b/fs_selfservice/FS-SelfService/cgi/cvv2_amex.png new file mode 100644 index 000000000..21c36a0ab Binary files /dev/null and b/fs_selfservice/FS-SelfService/cgi/cvv2_amex.png differ diff --git a/fs_selfservice/FS-SelfService/cgi/decline.html b/fs_selfservice/FS-SelfService/cgi/decline.html new file mode 100644 index 000000000..a37ba3ab6 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/decline.html @@ -0,0 +1,5 @@ +Processing error +Processing error

    +There has been an error processing your account. Please contact customer +support. + diff --git a/fs_selfservice/FS-SelfService/cgi/delete_svc.html b/fs_selfservice/FS-SelfService/cgi/delete_svc.html new file mode 100644 index 000000000..8468deb4b --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/delete_svc.html @@ -0,0 +1,17 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + + +<%= if ( $error ) { + $OUT .= qq!Error: $error!; +} else { + $OUT .= "$svc removed."; +} %> + + +
    +powered by freeside + + diff --git a/fs_selfservice/FS-SelfService/cgi/list_customers.html b/fs_selfservice/FS-SelfService/cgi/list_customers.html new file mode 100644 index 000000000..858e5e9ba --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/list_customers.html @@ -0,0 +1,39 @@ +Reseller +Reseller

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> + +<%= include('agent_menu') %> +
    + +<%= + if ( @customers ) { + $OUT .= ''. + ''. + "$td{'statuscolor'}. '">'. + ucfirst($customer->{'status'}). "". "$td". + "$td$a". $customer->{'name'}. "". + ''; + #"$td". + $col = $col eq $col1 ? $col2 : $col1; + } + $OUT .= '
    Customers'; + my $col1 = "ffffff"; + my $col2 = "dddddd"; + my $col = $col1; + + foreach my $customer ( @customers ) { + my $td = qq!!; + my $a = qq!'; + $OUT .= + '
    '; + } else { + $OUT .= 'No customers.

    '; + } +%> + +
    +
    +powered by freeside + + diff --git a/fs_selfservice/FS-SelfService/cgi/login.html b/fs_selfservice/FS-SelfService/cgi/login.html new file mode 100644 index 000000000..5607de783 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/login.html @@ -0,0 +1,29 @@ +Login +Login

    +<%= $error %> +
    + + + + + + + + + + + + + + + +
    Username + +
    Domain + +
    Password + +
    +

    +
    + diff --git a/fs_selfservice/FS-SelfService/cgi/logout.html b/fs_selfservice/FS-SelfService/cgi/logout.html new file mode 100644 index 000000000..0e774e9eb --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/logout.html @@ -0,0 +1,5 @@ +MyAccount +MyAccount

    +You have been logged out. + + diff --git a/fs_selfservice/FS-SelfService/cgi/make_ach_payment.html b/fs_selfservice/FS-SelfService/cgi/make_ach_payment.html new file mode 100644 index 000000000..f80142325 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/make_ach_payment.html @@ -0,0 +1,61 @@ +MyAccount + + +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + +Make a payment

    +
    + + + + + + + + + + + +<%= include('check') %> + + + + + +
    Amount Due +
    + $<%=sprintf("%.2f",$balance)%> +
    +
    Payment amount +
    + $"> +
    +
    + + Remember this information +
    + NAME="auto" VALUE="1" onClick="if (this.checked) { document.OneTrueForm.save.checked=true; }"> + Charge future payments to this account automatically +
    +
    + + +
    + +
    +powered by freeside + + diff --git a/fs_selfservice/FS-SelfService/cgi/make_payment.html b/fs_selfservice/FS-SelfService/cgi/make_payment.html new file mode 100644 index 000000000..89239c06b --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/make_payment.html @@ -0,0 +1,71 @@ +MyAccount + + +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + +Make a payment

    +
    + + + + + + + + + + + + + + +<%= include('card') %> + + + + + +
    Amount Due +
    + $<%=sprintf("%.2f",$balance)%> +
    +
    Payment amount +
    + $"> +
    +
    Card type + +
    + + Remember this information +
    + NAME="auto" VALUE="1" onClick="if (this.checked) { document.OneTrueForm.save.checked=true; }"> + Charge future payments to this card automatically +
    +
    + + +
    + +
    +powered by freeside + + diff --git a/fs_selfservice/FS-SelfService/cgi/map.gif b/fs_selfservice/FS-SelfService/cgi/map.gif new file mode 100644 index 000000000..ef884d8f9 Binary files /dev/null and b/fs_selfservice/FS-SelfService/cgi/map.gif differ diff --git a/fs_selfservice/FS-SelfService/cgi/myaccount.html b/fs_selfservice/FS-SelfService/cgi/myaccount.html new file mode 100644 index 000000000..d1f567187 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/myaccount.html @@ -0,0 +1,99 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + + +Hello <%= $name %>!

    +<%= $small_custview %> +
    +<%= if ( $balance > 0 ) { + $OUT .= qq! Make a payment

    !; +} %> +<%= + if ( @open_invoices ) { + $OUT .= ''. + ''; + my $link = qq!!; + my $a=qq!'; + $OUT .= + "$td${a}Invoice #". $invoice->{'invnum'}. "$td". + "$td$a". $invoice->{'date'}. "$td". + qq!'. + ''; + $col = $col eq $col1 ? $col2 : $col1; + } + $OUT .= '
    Open Invoices
    $a\$!. $invoice->{'owed'}. + '

    '; + } else { + $OUT .= 'You have no outstanding invoices.

    '; + } +%> + +<%= + if ( @support_services ) { + $OUT .= ''. + ''. + ''. + ''; + my $col1 = "ffffff"; + my $col2 = "dddddd"; + my $col = $col1; + + foreach my $support ( @support_services ) { + my $td = qq!$td$a". $support->{'pkgnum'}. "". + $td.$a. $support->{'pkg'}. "". + $td.$a. $support->{'time'}. "". + ''; + $col = $col eq $col1 ? $col2 : $col1; + } + $OUT .= '
    Support Time Remaining
    #PackageTime Remaining
    !; + my $a = qq!'; + $OUT .= + "

    '; + } else { + $OUT .= ''; + } +%> + +<%= + if ( @tickets ) { + $OUT .= ''. + ''. + ''. + ''; + my $col1 = "ffffff"; + my $col2 = "dddddd"; + my $col = $col1; + + foreach my $ticket ( @tickets ) { + my $td = qq!$td". $ticket->{'id'}. "". + $td. $ticket->{'subject'}. "". + $td. ($ticket->{'content'} || $ticket->{'priority'}). "". + $td. $ticket->{'queue'}. "". + $td. $ticket->{'status'}. "". + ''; + $col = $col eq $col1 ? $col2 : $col1; + } + $OUT .= '
    Open Tickets
    #SubjectPriorityQueueStatus
    !; + $OUT .= + "
    '; + } else { + $OUT .= ''; + } +%> + + +
    +powered by freeside + + + + diff --git a/fs_selfservice/FS-SelfService/cgi/myaccount_menu.html b/fs_selfservice/FS-SelfService/cgi/myaccount_menu.html new file mode 100644 index 000000000..ec5a8fa42 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/myaccount_menu.html @@ -0,0 +1,94 @@ +<%= $url = "$selfurl?session=$session_id;action="; ''; %> + + diff --git a/fs_selfservice/FS-SelfService/cgi/order_pkg.html b/fs_selfservice/FS-SelfService/cgi/order_pkg.html new file mode 100644 index 000000000..9cdd4cd6c --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/order_pkg.html @@ -0,0 +1,75 @@ + +Purchase additional package

    +<%= if ( $error ) { + $OUT .= qq!$error

    !; +} ''; %> + + + + +
    + + + +<%= + +my @menu = ( +{ title=>' ' }, +{ title=>'Overview', url=>'myaccount', size=>'+1', }, +{ title=>' ' }, + +{ title=>'Purchase', size=>'+1', }, + { title=>'Purchase additional package', + url=>'customer_order_pkg', 'indent'=>2 }, +); + +if ( 1 ) { #XXXFIXME "enable selfservice prepay features" flag or something, eventually per-pkg or something really fancy + + push @menu, ( + { title=>'Recharge my account with a credit card', + url=>'make_payment', indent=>2 }, + { title=>'Recharge my account with a check', + url=>'make_ach_payment', indent=>2 }, + { title=>'Recharge my account with a prepaid card', + url=>'recharge_prepay', indent=>2 }, + ); + +} + +push @menu, ( + +{ title=>' ' }, + +{ title=>'View my usage', url=>'view_usage', size=>'+1', }, +{ title=>'Setup my services', url=>'provision', size=>'+1', }, + +{ title=>' ' }, + +{ title=>'Change my information', size=>'+1', }, + { title=>'Change billing address', url=>'change_bill', indent=>2 }, + { title=>'Change service address', url=>'change_ship', indent=>2 }, + { title=>'Change payment information', url=>'change_pay', indent=>2 }, + { title=>'Change password(s)', url=>'change_password', indent=>2 }, + +{ title=>' ' }, + +{ title=>'Logout', url=>'logout', size=>'+1', }, + +); + +foreach my $item ( @menu ) { + + $OUT .= '{'url'} && $action eq $item->{'url'} ) { + $OUT .= ' BGCOLOR="#eeeeee" '. + ' STYLE="border-top: 1px solid black;'. + ' border-left: 1px solid black;'. + ' border-bottom: 1px solid black"'; + } else { + $OUT .= ' STYLE="border-right: 1px solid black"'; + } + $OUT.='>'; + + $OUT .= '' + if exists $item->{'size'}; + + $OUT .= ' ' x $item->{'indent'} + if exists $item->{'indent'}; + + $OUT .= '' + if exists $item->{'url'} && $action ne $item->{'url'}; + + $item->{'title'} =~ s/ / /g; + $OUT .= $item->{'title'}; + + $OUT .= '' + if exists $item->{'size'}; + + $OUT .= '' + if exists $item->{'url'} && $action ne $item->{'url'}; + + $OUT .= ''; + +} + +%> + + + +




    + +
    + + + + + + + + + + + + + + + +<%= + if ( $security_phrase ) { + $OUT .= < + + + +ENDOUT + } else { + $OUT .= ''; + } +%> +<%= + if ( @svc_acct_pop ) { + $OUT .= ''; + } else { + $OUT .= popselector(popnum=>$popnum, pops=>\@svc_acct_pop); + } +%> +
    Username
    Password
    Re-enter Password
    Security Phrase +
    Access number'. + popselector( 'popnum' => $popnum, + 'pops' => \@svc_acct_pop, + 'init_popstate' => $init_popstate, + 'popac' => $popac, + 'acstate' => $acstate, + ). + '
    + + + diff --git a/fs_selfservice/FS-SelfService/cgi/passwd.cgi b/fs_selfservice/FS-SelfService/cgi/passwd.cgi new file mode 100755 index 000000000..87e5e6843 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/passwd.cgi @@ -0,0 +1,61 @@ +#!/usr/bin/perl -T +#!/usr/bin/perl -Tw + +use strict; +use Getopt::Std; +use FS::SelfService qw(passwd); +use CGI; +use CGI::Carp qw(fatalsToBrowser); + +my $freeside_uid = scalar(getpwnam('freeside')); + +$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'} = ''; + +die "passwd.cgi isn't running as freeside user\n" if $> != $freeside_uid; + +my $cgi = new CGI; + +$cgi->param('username') =~ /^([^\n]{0,255}$)/ or die "Illegal username"; +my $me = $1; + +$cgi->param('domain') =~ /^([^\n]{0,255}$)/ or die "Illegal domain"; +my $domain = $1; + +$cgi->param('old_password') =~ /^([^\n]{0,255}$)/ or die "Illegal old_password"; +my $old_password = $1; + +$cgi->param('new_password') =~ /^([^\n]{0,255}$)/ or die "Illegal new_password"; +my $new_password = $1; + +die "New passwords don't match" + unless $new_password eq $cgi->param('new_password2'); + +my $rv = passwd( + 'username' => $me, + 'domain' => $domain, + 'old_password' => $old_password, + 'new_password' => $new_password, +); + +my $error = $rv->{error}; + +if ($error) { + die $error; +} else { + print $cgi->header(), < + + Password changed + + +

    Password changed

    +
    Your password has been changed. + + +END +} diff --git a/fs_selfservice/FS-SelfService/cgi/passwd.html b/fs_selfservice/FS-SelfService/cgi/passwd.html new file mode 100644 index 000000000..459c96aa8 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/passwd.html @@ -0,0 +1,28 @@ + + + Change password + + +

    Change password

    +
    + + + + + + + + + + + + + + + + +
    Username
    Domain
    Current password
    New password
    Re-enter new password
    +
    + + + diff --git a/fs_selfservice/FS-SelfService/cgi/payment_results.html b/fs_selfservice/FS-SelfService/cgi/payment_results.html new file mode 100644 index 000000000..9fe400faf --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/payment_results.html @@ -0,0 +1,16 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + +Payment results

    +<%= if ( $error ) { + $OUT .= qq!Error processing your payment: $error!; +} else { + $OUT .= 'Your payment was processed successfully. Thank you.'; +} %> + +
    +powered by freeside + + diff --git a/fs_selfservice/FS-SelfService/cgi/process_change_bill.html b/fs_selfservice/FS-SelfService/cgi/process_change_bill.html new file mode 100644 index 000000000..66a71e6e8 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/process_change_bill.html @@ -0,0 +1,13 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + + +Information updated successfully. + + +
    +powered by freeside + + diff --git a/fs_selfservice/FS-SelfService/cgi/process_change_password.html b/fs_selfservice/FS-SelfService/cgi/process_change_password.html new file mode 100644 index 000000000..4fdee79f3 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/process_change_password.html @@ -0,0 +1,13 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + + +Password changed for <%= $value %> <%= $label %>. + + +
    +powered by freeside + + diff --git a/fs_selfservice/FS-SelfService/cgi/process_change_pay.html b/fs_selfservice/FS-SelfService/cgi/process_change_pay.html new file mode 100644 index 000000000..66a71e6e8 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/process_change_pay.html @@ -0,0 +1,13 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + + +Information updated successfully. + + +
    +powered by freeside + + diff --git a/fs_selfservice/FS-SelfService/cgi/process_change_pkg.html b/fs_selfservice/FS-SelfService/cgi/process_change_pkg.html new file mode 100644 index 000000000..9347434ba --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/process_change_pkg.html @@ -0,0 +1,13 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + + +Package change successful. + + +
    +powered by freeside + + diff --git a/fs_selfservice/FS-SelfService/cgi/process_change_ship.html b/fs_selfservice/FS-SelfService/cgi/process_change_ship.html new file mode 100644 index 000000000..66a71e6e8 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/process_change_ship.html @@ -0,0 +1,13 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + + +Information updated successfully. + + +
    +powered by freeside + + diff --git a/fs_selfservice/FS-SelfService/cgi/process_order_pkg.html b/fs_selfservice/FS-SelfService/cgi/process_order_pkg.html new file mode 100755 index 000000000..79be5eba5 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/process_order_pkg.html @@ -0,0 +1,13 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + + +Package order successful. + + +
    +powered by freeside + + diff --git a/fs_selfservice/FS-SelfService/cgi/process_order_recharge.html b/fs_selfservice/FS-SelfService/cgi/process_order_recharge.html new file mode 100644 index 000000000..851bbed44 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/process_order_recharge.html @@ -0,0 +1,13 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + + +<%= $svc %> recharged successfully. + + +
    +powered by freeside + + diff --git a/fs_selfservice/FS-SelfService/cgi/process_svc_acct.html b/fs_selfservice/FS-SelfService/cgi/process_svc_acct.html new file mode 100644 index 000000000..3b812919a --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/process_svc_acct.html @@ -0,0 +1,13 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + + +<%= $svc %> setup successfully. + + +
    +powered by freeside + + diff --git a/fs_selfservice/FS-SelfService/cgi/process_svc_external.html b/fs_selfservice/FS-SelfService/cgi/process_svc_external.html new file mode 100644 index 000000000..19fec737f --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/process_svc_external.html @@ -0,0 +1,15 @@ +<%= $error ? 'MyAccount' : sprintf("Your serial number is %010d-$title", $id) %> +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + + +<%= $svc %> setup successfully. + +

    Your serial number is <%= sprintf("%010d-$title", $id) %> + + +
    +powered by freeside + + diff --git a/fs_selfservice/FS-SelfService/cgi/promocode.html b/fs_selfservice/FS-SelfService/cgi/promocode.html new file mode 100644 index 000000000..f8ee7f6eb --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/promocode.html @@ -0,0 +1,14 @@ +ISP Signup +ISP Signup - promotional code

    + + +Enter promotional code + + +
    + + diff --git a/fs_selfservice/FS-SelfService/cgi/provision.html b/fs_selfservice/FS-SelfService/cgi/provision.html new file mode 100644 index 000000000..d31e6070b --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/provision.html @@ -0,0 +1,10 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + +<%= include('provision_list') %> + +
    +powered by freeside + diff --git a/fs_selfservice/FS-SelfService/cgi/provision_list.html b/fs_selfservice/FS-SelfService/cgi/provision_list.html new file mode 100644 index 000000000..88d1c848b --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/provision_list.html @@ -0,0 +1,92 @@ +Setup services

    + + + + + +<%= foreach my $pkg ( + grep { scalar(@{$_->{part_svc}}) + || scalar(@{$_->{cust_svc}}) + } @cust_pkg + ) { + + $OUT .= #'
    '. + ''; + + my $col1 = "ffffff"; + my $col2 = "dddddd"; + my $col = $col1; + + foreach my $cust_svc ( @{ $pkg->{cust_svc} } ) { + my $td = qq!'. + "$td>". $cust_svc->{label}[1]. ''; + $OUT .= '
    password: '. encode_entities($cust_svc->{_password}). '' + if exists($cust_svc->{_password}); + $OUT .= ''. + "$td>"; + + #if ( $cust_svc->{label}[2] eq 'svc_acct' ) { + # $OUT .= qq!(!. + # 'change pw) '; + #} + + unless ( $cust_svc->{'svcnum'} == $svcnum ) { + $OUT .= qq!(!. + 'delete)'; + + } + $OUT .= ''; + $col = $col eq $col1 ? $col2 : $col1; + } + + $OUT .= '' + if scalar(@{$pkg->{part_svc}}) && scalar(@{$pkg->{cust_svc}}); + + $col = $col1; + + foreach my $part_svc ( @{ $pkg->{part_svc} } ) { + + my $td = qq!$td COLSPAN=3 ALIGN=center>". + qq!!. 'Setup '. $part_svc->{'svc'}. ' '. + '('. $part_svc->{'num_avail'}. ' available)'. + '' + #self-service only supports these services so far + if grep { $part_svc->{'svcdb'} eq $_ } qw( svc_acct svc_external ); + + $col = $col eq $col1 ? $col2 : $col1; + } + + #$OUT .= '
    '. + $pkg->{'pkg'}. '' . + qq!(! . + 'change)
    ". $cust_svc->{label}[0]. ':
    {'svcdb'} eq 'svc_external' + #&& $conf->exists('svc_external-skip_manual') + ) { + $link = "${url}process_svc_external;". + "pkgnum=$pkg->{'pkgnum'};". + "svcpart=$part_svc->{'svcpart'}"; + } else { + $link = "${url}provision_svc;". + "pkgnum=$pkg->{'pkgnum'};". + "svcpart=$part_svc->{'svcpart'}"; + } + + $OUT .= "

    '; + $OUT .= ' '; + +} %> + + diff --git a/fs_selfservice/FS-SelfService/cgi/provision_svc_acct.html b/fs_selfservice/FS-SelfService/cgi/provision_svc_acct.html new file mode 100644 index 000000000..50540742a --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/provision_svc_acct.html @@ -0,0 +1,11 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + +<%= include('svc_acct') %> + +
    +powered by freeside + + diff --git a/fs_selfservice/FS-SelfService/cgi/recharge_prepay.html b/fs_selfservice/FS-SelfService/cgi/recharge_prepay.html new file mode 100644 index 000000000..f8584597a --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/recharge_prepay.html @@ -0,0 +1,36 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + +Recharge with prepaid card

    +
    + + + + + + + + +
    Prepaid card number + +
    +
    + + +
    + +
    +powered by freeside + + diff --git a/fs_selfservice/FS-SelfService/cgi/recharge_results.html b/fs_selfservice/FS-SelfService/cgi/recharge_results.html new file mode 100644 index 000000000..b1eb7cb7a --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/recharge_results.html @@ -0,0 +1,24 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + +Recharge results

    +<%= if ( $error ) { + $OUT .= qq!Error processing your prepaid card: $error!; +} else { + $OUT .= 'Prepaid card recharge successful!

    '; + + $OUT .= '$'. sprintf('%.2f', $amount). ' added to your account.

    ' + if $amount; + + $OUT .= $duration. ' added to your account.

    ' + if $seconds; + + $OUT .= 'Thank you.'; +} %> + +
    +powered by freeside + + diff --git a/fs_selfservice/FS-SelfService/cgi/regcode.html b/fs_selfservice/FS-SelfService/cgi/regcode.html new file mode 100644 index 000000000..e639b9b53 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/regcode.html @@ -0,0 +1,14 @@ +ISP Signup +ISP Signup - registration code

    + +
    +Enter registration code + + +
    + + diff --git a/fs_selfservice/FS-SelfService/cgi/selfservice.cgi b/fs_selfservice/FS-SelfService/cgi/selfservice.cgi new file mode 100644 index 000000000..36557b662 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/selfservice.cgi @@ -0,0 +1,647 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw($DEBUG $cgi $session_id $form_max $template_dir); +use subs qw(do_template); +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use Text::Template; +use HTML::Entities; +use Date::Format; +use Number::Format 1.50; +use FS::SelfService qw( login customer_info edit_info invoice + payment_info process_payment + process_prepay + list_pkgs order_pkg signup_info order_recharge + part_svc_info provision_acct provision_external + unprovision_svc change_pkg domainselector + list_svcs list_svc_usage list_support_usage + myaccount_passwd + ); + +$template_dir = '.'; + +$DEBUG = 1; + +$form_max = 255; + +$cgi = new CGI; + +unless ( defined $cgi->param('session') ) { + do_template('login',{}); + exit; +} + +if ( $cgi->param('session') eq 'login' ) { + + $cgi->param('username') =~ /^\s*([a-z0-9_\-\.\&]{0,$form_max})\s*$/i + or die "illegal username"; + my $username = $1; + + $cgi->param('domain') =~ /^\s*([\w\-\.]{0,$form_max})\s*$/ + or die "illegal domain"; + my $domain = $1; + + $cgi->param('password') =~ /^(.{0,$form_max})$/ + or die "illegal password"; + my $password = $1; + + my $rv = login( + 'username' => $username, + 'domain' => $domain, + 'password' => $password, + ); + if ( $rv->{error} ) { + do_template('login', { + 'error' => $rv->{error}, + 'username' => $username, + 'domain' => $domain, + } ); + exit; + } else { + $cgi->param('session' => $rv->{session_id} ); + $cgi->param('action' => 'myaccount' ); + } +} + +$session_id = $cgi->param('session'); + +#order|pw_list XXX ??? +$cgi->param('action') =~ + /^(myaccount|view_invoice|make_payment|make_ach_payment|payment_results|ach_payment_results|recharge_prepay|recharge_results|logout|change_bill|change_ship|change_pay|process_change_bill|process_change_ship|process_change_pay|customer_order_pkg|process_order_pkg|customer_change_pkg|process_change_pkg|process_order_recharge|provision|provision_svc|process_svc_acct|process_svc_external|delete_svc|view_usage|view_usage_details|view_support_details|change_password|process_change_password)$/ + or die "unknown action ". $cgi->param('action'); +my $action = $1; + +warn "calling $action sub\n" + if $DEBUG; +$FS::SelfService::DEBUG = $DEBUG; +my $result = eval "&$action();"; +die $@ if $@; + +if ( $result->{error} eq "Can't resume session" + || $result->{error} eq "Expired session" ) { #ick + + do_template('login',{}); + exit; +} + +#warn $result->{'open_invoices'}; +#warn scalar(@{$result->{'open_invoices'}}); + +warn "processing template $action\n" + if $DEBUG; +do_template($action, { + 'session_id' => $session_id, + 'action' => $action, #so the menu knows what tab we're on... + %{$result} +}); + +#-- + +sub myaccount { customer_info( 'session_id' => $session_id ); } + +sub change_bill { my $payment_info = + payment_info( 'session_id' => $session_id ); + return $payment_info if ( $payment_info->{'error'} ); + my $customer_info = + customer_info( 'session_id' => $session_id ); + return { + %$payment_info, + %$customer_info, + }; + } +sub change_ship { change_bill(@_); } +sub change_pay { change_bill(@_); } + +sub _process_change_info { + my ($erroraction, @fields) = @_; + + my $results = ''; + + $results ||= edit_info ( + 'session_id' => $session_id, + map { ($_ => $cgi->param($_)) } grep { defined($cgi->param($_)) } @fields, + ); + + + if ( $results->{'error'} ) { + no strict 'refs'; + $action = $erroraction; + return { + $cgi->Vars, + %{&$action()}, + 'error' => ''. $results->{'error'}. '', + }; + } else { + return $results; + } +} + +sub process_change_bill { + _process_change_info( 'change_bill', + qw( first last company address1 address2 city state + county state zip country daytime night fax ) + ); +} + +sub process_change_ship { + my @list = map { "ship_$_" } + qw( first last company address1 address2 city state + county zip country daytime night fax + ); + if ($cgi->param('same') eq 'Y') { + foreach (@list) { $cgi->param($_, '') } + } + + _process_change_info( 'change_ship', @list ); +} + +sub process_change_pay { + _process_change_info( 'change_pay', + qw( payby payinfo payinfo1 payinfo2 month year payname + address1 address2 city county state zip country auto paytype + paystate ss stateid stateid_state ) + ); +} + +sub view_invoice { + + $cgi->param('invnum') =~ /^(\d+)$/ or die "illegal invnum"; + my $invnum = $1; + + invoice( 'session_id' => $session_id, + 'invnum' => $invnum, + ); + +} + +sub customer_order_pkg { + my $init_data = signup_info( 'customer_session_id' => $session_id ); + return $init_data if ( $init_data->{'error'} ); + + my $customer_info = customer_info( 'session_id' => $session_id ); + return $customer_info if ( $customer_info->{'error'} ); + + return { + ( map { $_ => $init_data->{$_} } + qw( part_pkg security_phrase svc_acct_pop ), + ), + %$customer_info, + }; +} + +sub customer_change_pkg { + my $init_data = signup_info( 'customer_session_id' => $session_id ); + return $init_data if ( $init_data->{'error'} ); + + my $customer_info = customer_info( 'session_id' => $session_id ); + return $customer_info if ( $customer_info->{'error'} ); + + return { + ( map { $_ => $init_data->{$_} } + qw( part_pkg security_phrase svc_acct_pop ), + ), + ( map { $_ => $cgi->param($_) } + qw( pkgnum pkg ) + ), + %$customer_info, + }; +} + +sub process_order_pkg { + + my $results = ''; + + unless ( length($cgi->param('_password')) ) { + my $init_data = signup_info( 'customer_session_id' => $session_id ); + $results = { 'error' => $init_data->{msgcat}{empty_password} }; + $results = { 'error' => $init_data->{error} } if($init_data->{error}); + } + if ( $cgi->param('_password') ne $cgi->param('_password2') ) { + my $init_data = signup_info( 'customer_session_id' => $session_id ); + $results = { 'error' => $init_data->{msgcat}{passwords_dont_match} }; + $results = { 'error' => $init_data->{error} } if($init_data->{error}); + $cgi->param('_password', ''); + $cgi->param('_password2', ''); + } + + $results ||= order_pkg ( + 'session_id' => $session_id, + map { $_ => $cgi->param($_) } + qw( custnum pkgpart username _password _password2 sec_phrase popnum ) + ); + + + if ( $results->{'error'} ) { + $action = 'customer_order_pkg'; + return { + $cgi->Vars, + %{customer_order_pkg()}, + 'error' => ''. $results->{'error'}. '', + }; + } else { + return $results; + } + +} + +sub process_change_pkg { + + my $results = ''; + + $results ||= change_pkg ( + 'session_id' => $session_id, + map { $_ => $cgi->param($_) } + qw( pkgpart pkgnum ) + ); + + + if ( $results->{'error'} ) { + $action = 'customer_change_pkg'; + return { + $cgi->Vars, + %{customer_change_pkg()}, + 'error' => ''. $results->{'error'}. '', + }; + } else { + return $results; + } + +} + +sub process_order_recharge { + + my $results = ''; + + $results ||= order_recharge ( + 'session_id' => $session_id, + map { $_ => $cgi->param($_) } + qw( svcnum ) + ); + + + if ( $results->{'error'} ) { + $action = 'view_usage'; + if ($results->{'error'} eq '_decline') { + $results->{'error'} = "There has been an error processing your account. Please contact customer support." + } + return { + $cgi->Vars, + %{view_usage()}, + 'error' => ''. $results->{'error'}. '', + }; + } else { + return $results; + } + +} + +sub make_payment { + payment_info( 'session_id' => $session_id ); +} + +sub payment_results { + + use Business::CreditCard; + + #we should only do basic checking here for DoS attacks and things + #that couldn't be constructed by the web form... let process_payment() do + #the rest, it gives better error messages + + $cgi->param('amount') =~ /^\s*(\d+(\.\d{2})?)\s*$/ + or die "Illegal amount: ". $cgi->param('amount'); #!!! + my $amount = $1; + + my $payinfo = $cgi->param('payinfo'); + $payinfo =~ s/\D//g; + $payinfo =~ /^(\d{13,16})$/ + #or $error ||= $init_data->{msgcat}{invalid_card}; #. $self->payinfo; + or die "illegal card"; #!!! + $payinfo = $1; + validate($payinfo) + #or $error ||= $init_data->{msgcat}{invalid_card}; #. $self->payinfo; + or die "invalid card"; #!!! + + if ( $cgi->param('card_type') ) { + cardtype($payinfo) eq $cgi->param('card_type') + #or $error ||= $init_data->{msgcat}{not_a}. $cgi->param('CARD_type'); + or die "not a ". $cgi->param('card_type'); + } + + $cgi->param('paycvv') =~ /^\s*(.{0,4})\s*$/ or die "illegal CVV2"; + my $paycvv = $1; + + $cgi->param('month') =~ /^(\d{2})$/ or die "illegal month"; + my $month = $1; + $cgi->param('year') =~ /^(\d{4})$/ or die "illegal year"; + my $year = $1; + + $cgi->param('payname') =~ /^(.{0,80})$/ or die "illegal payname"; + my $payname = $1; + + $cgi->param('address1') =~ /^(.{0,80})$/ or die "illegal address1"; + my $address1 = $1; + + $cgi->param('address2') =~ /^(.{0,80})$/ or die "illegal address2"; + my $address2 = $1; + + $cgi->param('city') =~ /^(.{0,80})$/ or die "illegal city"; + my $city = $1; + + $cgi->param('state') =~ /^(.{2})$/ or die "illegal state"; + my $state = $1; + + $cgi->param('zip') =~ /^(.{0,10})$/ or die "illegal zip"; + my $zip = $1; + + my $save = 0; + $save = 1 if $cgi->param('save'); + + my $auto = 0; + $auto = 1 if $cgi->param('auto'); + + $cgi->param('paybatch') =~ /^([\w\-\.]+)$/ or die "illegal paybatch"; + my $paybatch = $1; + + process_payment( + 'session_id' => $session_id, + 'payby' => 'CARD', + 'amount' => $amount, + 'payinfo' => $payinfo, + 'paycvv' => $paycvv, + 'month' => $month, + 'year' => $year, + 'payname' => $payname, + 'address1' => $address1, + 'address2' => $address2, + 'city' => $city, + 'state' => $state, + 'zip' => $zip, + 'save' => $save, + 'auto' => $auto, + 'paybatch' => $paybatch, + ); + +} + +sub make_ach_payment { + payment_info( 'session_id' => $session_id ); +} + +sub ach_payment_results { + + #we should only do basic checking here for DoS attacks and things + #that couldn't be constructed by the web form... let process_payment() do + #the rest, it gives better error messages + + $cgi->param('amount') =~ /^\s*(\d+(\.\d{2})?)\s*$/ + or die "illegal amount"; #!!! + my $amount = $1; + + my $payinfo1 = $cgi->param('payinfo1'); + $payinfo1=~ /^(\d+)$/ + or die "illegal account"; #!!! + $payinfo1= $1; + + my $payinfo2 = $cgi->param('payinfo2'); + $payinfo2=~ /^(\d+)$/ + or die "illegal ABA/routing code"; #!!! + $payinfo2= $1; + + $cgi->param('payname') =~ /^(.{0,80})$/ or die "illegal payname"; + my $payname = $1; + + $cgi->param('paystate') =~ /^(.{0,2})$/ or die "illegal paystate"; + my $paystate = $1; + + $cgi->param('paytype') =~ /^(.{0,80})$/ or die "illegal paytype"; + my $paytype = $1; + + $cgi->param('ss') =~ /^(.{0,80})$/ or die "illegal ss"; + my $ss = $1; + + $cgi->param('stateid') =~ /^(.{0,80})$/ or die "illegal stateid"; + my $stateid = $1; + + $cgi->param('stateid_state') =~ /^(.{0,2})$/ or die "illegal stateid_state"; + my $stateid_state = $1; + + my $save = 0; + $save = 1 if $cgi->param('save'); + + my $auto = 0; + $auto = 1 if $cgi->param('auto'); + + $cgi->param('paybatch') =~ /^([\w\-\.]+)$/ or die "illegal paybatch"; + my $paybatch = $1; + + process_payment( + 'session_id' => $session_id, + 'payby' => 'CHEK', + 'amount' => $amount, + 'payinfo1' => $payinfo1, + 'payinfo2' => $payinfo2, + 'month' => '12', + 'year' => '2037', + 'payname' => $payname, + 'paytype' => $paytype, + 'paystate' => $paystate, + 'ss' => $ss, + 'stateid' => $stateid, + 'stateid_state' => $stateid_state, + 'save' => $save, + 'auto' => $auto, + 'paybatch' => $paybatch, + ); + +} + +sub recharge_prepay { + customer_info( 'session_id' => $session_id ); +} + +sub recharge_results { + + my $prepaid_cardnum = $cgi->param('prepaid_cardnum'); + $prepaid_cardnum =~ s/\W//g; + $prepaid_cardnum =~ /^(\w*)$/ or die "illegal prepaid card number"; + $prepaid_cardnum = $1; + + process_prepay ( 'session_id' => $session_id, + 'prepaid_cardnum' => $prepaid_cardnum, + ); +} + +sub logout { + FS::SelfService::logout( 'session_id' => $session_id ); +} + +sub provision { + my $result = list_pkgs( 'session_id' => $session_id ); + die $result->{'error'} if exists $result->{'error'} && $result->{'error'}; + $result; +} + +sub provision_svc { + + my $result = part_svc_info( + 'session_id' => $session_id, + map { $_ => $cgi->param($_) } qw( pkgnum svcpart ), + ); + die $result->{'error'} if exists $result->{'error'} && $result->{'error'}; + + $result->{'svcdb'} =~ /^svc_(.*)$/ + #or return { 'error' => 'Unknown svcdb '. $result->{'svcdb'} }; + or die 'Unknown svcdb '. $result->{'svcdb'}; + $action .= "_$1"; + + $result; +} + +sub process_svc_acct { + + my $result = provision_acct ( + 'session_id' => $session_id, + map { $_ => $cgi->param($_) } qw( + pkgnum svcpart username domsvc _password _password2 sec_phrase popnum ) + ); + + if ( exists $result->{'error'} && $result->{'error'} ) { + #warn "$result $result->{'error'}"; + $action = 'provision_svc_acct'; + return { + $cgi->Vars, + %{ part_svc_info( 'session_id' => $session_id, + map { $_ => $cgi->param($_) } qw( pkgnum svcpart ) + ) + }, + 'error' => $result->{'error'}, + }; + } else { + #warn "$result $result->{'error'}"; + return $result; + } + +} + +sub process_svc_external { + provision_external ( + 'session_id' => $session_id, + map { $_ => $cgi->param($_) } qw( pkgnum svcpart ) + ); +} + +sub delete_svc { + unprovision_svc( + 'session_id' => $session_id, + 'svcnum' => $cgi->param('svcnum'), + ); +} + +sub view_usage { + list_svcs( + 'session_id' => $session_id, + 'svcdb' => 'svc_acct', + 'ncancelled' => 1, + ); +} + +sub view_usage_details { + list_svc_usage( + 'session_id' => $session_id, + 'svcnum' => $cgi->param('svcnum'), + 'beginning' => $cgi->param('beginning') || '', + 'ending' => $cgi->param('ending') || '', + ); +} + +sub view_support_details { + list_support_usage( + 'session_id' => $session_id, + 'svcnum' => $cgi->param('svcnum'), + 'beginning' => $cgi->param('beginning') || '', + 'ending' => $cgi->param('ending') || '', + ); +} + +sub change_password { + list_svcs( + 'session_id' => $session_id, + 'svcdb' => 'svc_acct', + ); +}; + +sub process_change_password { + + my $result = myaccount_passwd( + 'session_id' => $session_id, + map { $_ => $cgi->param($_) } qw( svcnum new_password new_password2 ) + ); + + if ( exists $result->{'error'} && $result->{'error'} ) { + + $action = 'change_password'; + return { + $cgi->Vars, + %{ list_svcs( 'session_id' => $session_id, + 'svcdb' => 'svc_acct', + ) + }, + #'svcnum' => $cgi->param('svcnum'), + 'error' => $result->{'error'} + }; + + } else { + + return $result; + + } + +} + +#-- + +sub do_template { + my $name = shift; + my $fill_in = shift; + + $cgi->delete_all(); + $fill_in->{'selfurl'} = $cgi->self_url; + $fill_in->{'cgi'} = \$cgi; + + my $template = new Text::Template( TYPE => 'FILE', + SOURCE => "$template_dir/$name.html", + DELIMITERS => [ '<%=', '%>' ], + UNTAINT => 1, ) + or die $Text::Template::ERROR; + + print $cgi->header( '-expires' => 'now' ), + $template->fill_in( PACKAGE => 'FS::SelfService::_selfservicecgi', + HASH => $fill_in + ); +} + +#*FS::SelfService::_selfservicecgi::include = \&Text::Template::fill_in_file; + +package FS::SelfService::_selfservicecgi; + +#use FS::SelfService qw(regionselector expselect popselector); +use HTML::Entities; +use FS::SelfService qw(regionselector popselector domainselector); + +#false laziness w/agent.cgi +sub include { + my $name = shift; + my $template = new Text::Template( TYPE => 'FILE', + SOURCE => "$main::template_dir/$name.html", + DELIMITERS => [ '<%=', '%>' ], + UNTAINT => 1, + ) + or die $Text::Template::ERROR; + + $template->fill_in( PACKAGE => 'FS::SelfService::_selfservicecgi', + #HASH => $fill_in + ); + +} + diff --git a/fs_selfservice/FS-SelfService/cgi/signup-agentselect.html b/fs_selfservice/FS-SelfService/cgi/signup-agentselect.html new file mode 100755 index 000000000..7851c5601 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/signup-agentselect.html @@ -0,0 +1,195 @@ +ISP Signup form +ISP Signup form

    +<%= $error %> +
    + + + +Agent

    +Contact Information + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    *Contact name
    (last, first)
    , +
    Company
    *Address
     
    *City*State/Country + <%= + ($county_html, $state_html, $country_html) = + regionselector( $county, $state, $country ); + + "$county_html $state_html"; + %> + *Zip
    *Country<%= $country_html %>
    Day Phone
    Night Phone
    Fax
    * required fields
    +
    Billing information + + +<%= scalar(@payby) > 1 ? '' : '' %> +
    + + <%= + $OUT .= ' + + Postal mail invoice +
    Email invoice +
    Billing type
    + + + + <%= + + my $cardselect = ''; + + my %payby = ( + 'CARD' => qq!Credit card
    *$cardselect
    *Exp !. expselect("CARD"). qq!
    *Name on card
    !, + 'DCRD' => qq!Credit card
    *$cardselect
    *Exp !. expselect("DCRD"). qq!
    *Name on card
    !, + 'CHEK' => qq!Electronic check
    ${r}Account number
    ${r}ABA/Routing code
    ${r}Bank name !, + 'DCHK' => qq!Electronic check
    ${r}Account number
    ${r}ABA/Routing code
    ${r}Bank name !, + 'LECB' => qq!Phone bill billing
    ${r}Phone number !, + 'BILL' => qq!Billing
    P.O.
    *Exp !. expselect("BILL", "12-2037"). qq!
    *Attention
    !, + 'COMP' => qq!Complimentary
    *Approved by
    *Exp !. expselect("COMP"), + 'PREPAY' => qq!Prepaid card
    *!, + ); + + my( $account, $aba ) = split('@', $payinfo); + my %paybychecked = ( + 'CARD' => qq!Credit card
    *$cardselect
    *Exp !. expselect("CARD", $paydate). qq!
    *Name on card
    !, + 'DCRD' => qq!Credit card
    *$cardselect
    *Exp !. expselect("DCRD", $paydate). qq!
    *Name on card
    !, + 'CHEK' => qq!Electronic check
    ${r}Account number
    ${r}ABA/Routing code
    ${r}Bank name !, + 'DCHK' => qq!Electronic check
    ${r}Account number
    ${r}ABA/Routing code
    ${r}Bank name !, + 'LECB' => qq!Phone bill billing
    ${r}Phone number !, + 'BILL' => qq!Billing
    P.O.
    *Exp !. expselect("BILL", $paydate). qq!
    *Attention
    !, + 'COMP' => qq!Complimentary
    *Approved by
    *Exp !. expselect("COMP", $paydate), + 'PREPAY' => qq!Prepaid card
    *!, + ); + + for (@payby) { + if ( scalar(@payby) == 1) { + $OUT .= '"; + } else { + $OUT .= qq!!; + } else { + $OUT .= qq!> $payby{$_}!; + } + + } + } + %> + +
    '. + qq!!. + "$paybychecked{$_} $paybychecked{$_}
    * required fields for each billing type +

    First package + + + + + + + + + + + + + + + + +<%= + if ( $init_data->{'security_phrase'} ) { + $OUT .= < + + + +ENDOUT + } else { + $OUT .= ''; + } +%> +<%= + if ( scalar(@$pops) ) { + $OUT .= ''; + } else { + $OUT .= popselector($popnum); + } +%> +
    Username
    Password
    Re-enter Password
    Security Phrase +
    Access number'. + popselector($popnum). '
    +

    +
    diff --git a/fs_selfservice/FS-SelfService/cgi/signup-alternate.html b/fs_selfservice/FS-SelfService/cgi/signup-alternate.html new file mode 100755 index 000000000..490cefa5e --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/signup-alternate.html @@ -0,0 +1,218 @@ +ISP Signup form +ISP Signup form

    +<%= $error %> +
    + + + + +Contact Information + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    *Contact name
    (last, first)
    , +
    Company
    *Address
     
    *City*State/Country*Zip
    Day Phone
    Night Phone
    Fax
    * required fields
    + +

    + + + + + + + + + + + + + + +<%= if ( $init_data->{'security_phrase'} ) { + < + + + +ENDOUT + } else { + ''; + } +%> + +<%= if ( scalar(@$pops) ) { + ''; + } else { + popselector($popnum); + } +%> + +
    *Username
    *Password
    *Re-enter Password
    Security Phrase +
    Access number'. + popselector($popnum). '
    * required fields + +

    First package + + <%= use Tie::IxHash; + my %pkgpart2payby = map { $_->{pkgpart} => $_->{payby}[0] } @{$packages}; + tie my %options, 'Tie::IxHash', + '' => '(none)', + map { $_->{pkgpart} => $_->{pkg} } + sort { $a->{recur} <=> $b->{recur} } + @{$packages} + ; + + use HTML::Widgets::SelectLayers 0.02; + my @form_text = qw( magic ref ss agentnum + last first company address1 address2 + city zip daytime night fax + username _password _password2 sec_phrase ); + my @form_select = qw( state ); #county country + if ( scalar(@$pops) == 0 or scalar(@$pops) == 1 ) { + push @form_text, 'popnum', + } else { + push @form_select, 'popnum', + } + my $widget = new HTML::Widgets::SelectLayers( + options => \%options, + selected_layer => $pkgpart, + form_name => 'dummy', + form_action => $self_url, + form_text => \@form_text, + form_select => \@form_select, + layer_callback => sub { + my $layer = shift; + my $html = qq( ); + + if ( $pkgpart2payby{$layer} eq 'BILL' ) { + $html .= < + + + + + +

    +ENDOUT + } elsif ( $pkgpart2payby{$layer} eq 'CARD' ) { + my $postal_checked = ''; + my @invoicing_list = split(', ', $invoicing_list ); + $postal_checked = 'CHECKED' + if ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list; + + $invoicing_list= join(', ', grep { $_ ne 'POST' } @invoicing_list ); + + my $expselect = expselect("CARD", $paydate); + + my $cardselect = ''; + + $html .= < +

    Billing information + + + + + + + + + + + + + + + + + + + + + + +
    Email statement to
    *Credit card type$cardselect
    *Card number
    **Exp$expselect
    *Name on card
    +* required fields +

    +ENDOUT + } else { + $html = <Please select a package.
    +ENDOUT + + } + + $html; + + }, + ); + + $widget->html; + + + %> + diff --git a/fs_selfservice/FS-SelfService/cgi/signup-billaddress.html b/fs_selfservice/FS-SelfService/cgi/signup-billaddress.html new file mode 100755 index 000000000..3cf9d2505 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/signup-billaddress.html @@ -0,0 +1,307 @@ +ISP Signup form + + +ISP Signup form

    +<%= $error %> + + + + +Where did you hear about our service?

    +Billing Address (where credit card statement is sent) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    *Exact name on card
    (last, first)
    , +
    Company
    *Address
     
    *City*State/Country + <%= + ($county_html, $state_html, $country_html) = + regionselector( $county, $state, $country, '', 'changed(this)' ); + + "$county_html $state_html"; + %> + *Zip
    *Country<%= $country_html %>
    Day Phone
    Night Phone
    Fax
    + + + +

    +Service Address +(>same as billing address)
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    *Contact name
    (last, first)
    , +
    Company
    *Address
     
    *City*State/Country + <%= + ($ship_county_html, $ship_state_html, $ship_country_html) = + regionselector( $ship_county, + $ship_state, + $ship_country, + 'ship_', + 'changed(this)', + ); + + "$ship_county_html $ship_state_html"; + %> + *Zip
    *Country<%= $ship_country_html %>
    Day Phone
    Night Phone
    Fax
    + +* required fields
    + +
    Billing information + + +<%= scalar(@payby) > 1 ? '' : '' %> +
    + + <%= + $OUT .= ' + + Postal mail invoice +
    Email invoice +
    Billing type
    + + + + <%= + + my $cardselect = ''; + + my %payby = ( + 'CARD' => qq!Credit card
    *$cardselect
    *Exp !. expselect("CARD"), #. qq!
    *Name on card
    !, + 'DCRD' => qq!Credit card
    *$cardselect
    *Exp !. expselect("DCRD"), #. qq!
    *Name on card
    !, + 'CHEK' => qq!Electronic check
    ${r}Account number
    ${r}ABA/Routing code
    ${r}Bank name !, + 'DCHK' => qq!Electronic check
    ${r}Account number
    ${r}ABA/Routing code
    ${r}Bank name !, + 'LECB' => qq!Phone bill billing
    ${r}Phone number !, + 'BILL' => qq!Billing
    P.O.
    *Exp !. expselect("BILL", "12-2037"). qq!
    *Attention
    !, + 'COMP' => qq!Complimentary
    *Approved by
    *Exp !. expselect("COMP"), + 'PREPAY' => qq!Prepaid card
    *!, + ); + + if ( $init_data->{'cvv_enabled'} ) { + foreach my $payby ( grep { exists $payby{$_} } qw(CARD DCRD) ) { #1.4/1.5 + $payby{$payby} .= qq!
    CVV2 (help!; + } + } + + my( $account, $aba ) = split('@', $payinfo); + my %paybychecked = ( + 'CARD' => qq!Credit card
    *$cardselect
    *Exp !. expselect("CARD", $paydate), #. qq!
    *Name on card
    !, + 'DCRD' => qq!Credit card
    *$cardselect
    *Exp !. expselect("DCRD", $paydate), #. qq!
    *Name on card
    !, + 'CHEK' => qq!Electronic check
    ${r}Account number
    ${r}ABA/Routing code
    ${r}Bank name !, + 'DCHK' => qq!Electronic check
    ${r}Account number
    ${r}ABA/Routing code
    ${r}Bank name !, + 'LECB' => qq!Phone bill billing
    ${r}Phone number !, + 'BILL' => qq!Billing
    P.O.
    *Exp !. expselect("BILL", $paydate). qq!
    *Attention
    !, + 'COMP' => qq!Complimentary
    *Approved by
    *Exp !. expselect("COMP", $paydate), + 'PREPAY' => qq!Prepaid card
    *!, + ); + + if ( $init_data->{'cvv_enabled'} ) { + foreach my $payby ( grep { exists $payby{$_} } qw(CARD DCRD) ) { #1.4/1.5 + $paybychecked{$payby} .= qq!
    CVV2 (help!; + } + } + + for (@payby) { + if ( scalar(@payby) == 1) { + $OUT .= '"; + } else { + $OUT .= qq!!; + } else { + $OUT .= qq!> $payby{$_}!; + } + + } + } + %> + +
    '. + qq!!. + "$paybychecked{$_} $paybychecked{$_}
    * required fields for each billing type +

    First package + + + + + + + + + + + + + + + + + +<%= + if ( $init_data->{'security_phrase'} ) { + $OUT .= < + + + +ENDOUT + } else { + $OUT .= ''; + } +%> +<%= + if ( scalar(@$pops) ) { + $OUT .= ''; + } else { + $OUT .= popselector($popnum); + } +%> +
    Username
    Password
    Re-enter Password
    Security Phrase +
    Access number'. + popselector($popnum). '
    +

    + diff --git a/fs_selfservice/FS-SelfService/cgi/signup-freeoption.html b/fs_selfservice/FS-SelfService/cgi/signup-freeoption.html new file mode 100755 index 000000000..40ad03c0b --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/signup-freeoption.html @@ -0,0 +1,262 @@ +ISP Signup form + + +ISP Signup form

    +<%= $error %> +
    + + + +Where did you hear about our service?

    +Contact Information + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    *Contact name
    (last, first)
    , +
    Company
    *Address
     
    *City*State/Country + <%= + ($county_html, $state_html, $country_html) = + regionselector( $county, $state, $country ); + + "$county_html $state_html"; + %> + *Zip
    *Country<%= $country_html %>
    Day Phone
    Night Phone
    Fax
    * required fields
    +
    +<%= + my $first_payby = $packages->[0]{'payby'}[0]; + unless ( grep { scalar( @{$_->{'payby'}} ) > 1 + || $_->{'payby'}->[0] ne $first_payby + } @$packages + ) { + @payby = ( $first_payby ); + } + + unless ( scalar(@payby) == 1 && $payby[0] eq 'BILL' ) { + + $OUT .= ' Billing information + + '; + + $OUT .= '' + if scalar(@payby) > 1; + + $OUT .= '
    +
    Billing type
    '; + + } else { + $OUT .= ' + '; + } + +%> + + + + + <%= + + my $cardselect = ''; + + my %payby = ( + 'CARD' => qq!Credit card
    *$cardselect
    *Exp !. expselect("CARD"). qq!
    *Name on card
    !, + 'DCRD' => qq!Credit card
    *$cardselect
    *Exp !. expselect("DCRD"). qq!
    *Name on card
    !, + 'CHEK' => qq!Electronic check
    ${r}Account number
    ${r}ABA/Routing code
    ${r}Bank name !, + 'DCHK' => qq!Electronic check
    ${r}Account number
    ${r}ABA/Routing code
    ${r}Bank name !, + 'LECB' => qq!Phone bill billing
    ${r}Phone number !, + 'BILL' => <<'END', + + + + +END + 'COMP' => qq!Complimentary
    *Approved by
    *Exp !. expselect("COMP"), + 'PREPAY' => qq!Prepaid card
    *!, + ); + + if ( $init_data->{'cvv_enabled'} ) { + foreach my $payby ( grep { exists $payby{$_} } qw(CARD DCRD) ) { #1.4/1.5 + $payby{$payby} .= qq!
    CVV2 (help!; + } + } + + my( $account, $aba ) = split('@', $payinfo); + my %paybychecked = ( + 'CARD' => qq!Credit card
    *$cardselect
    *Exp !. expselect("CARD", $paydate). qq!
    *Name on card
    !, + 'DCRD' => qq!Credit card
    *$cardselect
    *Exp !. expselect("DCRD", $paydate). qq!
    *Name on card
    !, + 'CHEK' => qq!Electronic check
    ${r}Account number
    ${r}ABA/Routing code
    ${r}Bank name !, + 'DCHK' => qq!Electronic check
    ${r}Account number
    ${r}ABA/Routing code
    ${r}Bank name !, + 'LECB' => qq!Phone bill billing
    ${r}Phone number !, + 'BILL' => <<'END', + + + + +END + + 'COMP' => qq!Complimentary
    *Approved by
    *Exp !. expselect("COMP", $paydate), + 'PREPAY' => qq!Prepaid card
    *!, + ); + + if ( $init_data->{'cvv_enabled'} ) { + foreach my $payby ( grep { exists $payby{$_} } qw(CARD DCRD) ) { #1.4/1.5 + $paybychecked{$payby} .= qq!
    CVV2 (help!; + } + } + + for (@payby) { + if ( scalar(@payby) == 1) { + $OUT .= '"; + } else { + $OUT .= qq!!; + } else { + $OUT .= qq!> $payby{$_}!; + } + + } + } + %> + +
    '. + qq!!. + "$paybychecked{$_} $paybychecked{$_}
    +<%= unless ( scalar(@payby) == 1 && $payby[0] eq 'BILL' ) { + $OUT .= '* required fields for each billing type'; + } + ''; +%> +

    First package + + + + + + + + + + + + + + + + +<%= + if ( $init_data->{'security_phrase'} ) { + $OUT .= < + + + +ENDOUT + } else { + $OUT .= ''; + } +%> +<%= + if ( scalar(@$pops) ) { + $OUT .= ''; + } else { + $OUT .= popselector($popnum); + } +%> +
    Username
    Password
    Re-enter Password
    Security Phrase +
    Access number'. + popselector($popnum). '
    +

    +
    diff --git a/fs_selfservice/FS-SelfService/cgi/signup-snarf.html b/fs_selfservice/FS-SelfService/cgi/signup-snarf.html new file mode 100755 index 000000000..d167efbf9 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/signup-snarf.html @@ -0,0 +1,228 @@ +ISP Signup form + + +ISP Signup form

    +<%= $error %> +
    + + + +Contact Information + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    *Contact name
    (last, first)
    , +
    Company
    *Address
     
    *City*State/Country + <%= + ($county_html, $state_html, $country_html) = + regionselector( $county, $state, $country ); + + "$county_html $state_html"; + %> + *Zip
    *Country<%= $country_html %>
    Day Phone
    Night Phone
    Fax
    * required fields
    +
    Billing information + + +<%= scalar(@payby) > 1 ? '' : '' %> +
    + + <%= + $OUT .= ' + + Postal mail invoice +
    Email invoice +
    Billing type
    + + + + <%= + + my $cardselect = ''; + + my %payby = ( + 'CARD' => qq!Credit card
    *$cardselect
    *Exp !. expselect("CARD"). qq!
    *Name on card
    !, + 'DCRD' => qq!Credit card
    *$cardselect
    *Exp !. expselect("DCRD"). qq!
    *Name on card
    !, + 'CHEK' => qq!Electronic check
    ${r}Account number
    ${r}ABA/Routing code
    ${r}Bank name !, + 'DCHK' => qq!Electronic check
    ${r}Account number
    ${r}ABA/Routing code
    ${r}Bank name !, + 'LECB' => qq!Phone bill billing
    ${r}Phone number !, + 'BILL' => qq!Billing
    P.O.
    *Exp !. expselect("BILL", "12-2037"). qq!
    *Attention
    !, + 'COMP' => qq!Complimentary
    *Approved by
    *Exp !. expselect("COMP"), + 'PREPAY' => qq!Prepaid card
    *!, + ); + + if ( $init_data->{'cvv_enabled'} ) { + foreach my $payby ( grep { exists $payby{$_} } qw(CARD DCRD) ) { #1.4/1.5 + $payby{$payby} .= qq!
    CVV2 (help!; + } + } + + my( $account, $aba ) = split('@', $payinfo); + my %paybychecked = ( + 'CARD' => qq!Credit card
    *$cardselect
    *Exp !. expselect("CARD", $paydate). qq!
    *Name on card
    !, + 'DCRD' => qq!Credit card
    *$cardselect
    *Exp !. expselect("DCRD", $paydate). qq!
    *Name on card
    !, + 'CHEK' => qq!Electronic check
    ${r}Account number
    ${r}ABA/Routing code
    ${r}Bank name !, + 'DCHK' => qq!Electronic check
    ${r}Account number
    ${r}ABA/Routing code
    ${r}Bank name !, + 'LECB' => qq!Phone bill billing
    ${r}Phone number !, + 'BILL' => qq!Billing
    P.O.
    *Exp !. expselect("BILL", $paydate). qq!
    *Attention
    !, + 'COMP' => qq!Complimentary
    *Approved by
    *Exp !. expselect("COMP", $paydate), + 'PREPAY' => qq!Prepaid card
    *!, + ); + + if ( $init_data->{'cvv_enabled'} ) { + foreach my $payby ( grep { exists $payby{$_} } qw(CARD DCRD) ) { #1.4/1.5 + $paybychecked{$payby} .= qq!
    CVV2 (help!; + } + } + + for (@payby) { + if ( scalar(@payby) == 1) { + $OUT .= '"; + } else { + $OUT .= qq!!; + } else { + $OUT .= qq!> $payby{$_}!; + } + + } + } + %> + +
    '. + qq!!. + "$paybychecked{$_} $paybychecked{$_}
    * required fields for each billing type +

    First package + + + + + + + + + + + + + + + + +<%= + if ( $init_data->{'security_phrase'} ) { + $OUT .= < + + + +ENDOUT + } else { + $OUT .= ''; + } +%> +<%= + if ( scalar(@$pops) ) { + $OUT .= ''; + } else { + $OUT .= popselector($popnum); + } +%> +
    Username
    Password
    Re-enter Password
    Security Phrase +
    Access number'. + popselector($popnum). '
    +

    Enter up to ten external accounts from which to retrieve email + + + + + + +<%= + for my $num ( 1..10 ) { + no strict 'vars'; + $OUT .= qq!!. + qq!!. + qq!!. + qq!!. + qq!!; + } +%> +
    Mail serverUsernamePassword
    + +

    +
    diff --git a/fs_selfservice/FS-SelfService/cgi/signup.cgi b/fs_selfservice/FS-SelfService/cgi/signup.cgi new file mode 100755 index 000000000..e07b6ee5a --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/signup.cgi @@ -0,0 +1,349 @@ +#!/usr/bin/perl -T +#!/usr/bin/perl -Tw + +use strict; +use vars qw( @payby $cgi $init_data + $self_url $error $agentnum + + $ieak_file $ieak_template + $signup_html $signup_template + $success_html $success_template + $decline_html $decline_template + ); + +use subs qw( print_form print_okay print_decline + success_default decline_default + ); +use CGI; +#use CGI::Carp qw(fatalsToBrowser); +use Text::Template; +use Business::CreditCard; +use HTTP::BrowserDetect; +use FS::SelfService qw( signup_info new_customer ); + +#acceptable payment methods +# +#@payby = qw( CARD BILL COMP ); +#@payby = qw( CARD BILL ); +#@payby = qw( CARD ); +@payby = qw( CARD PREPAY ); + +$ieak_file = '/usr/local/freeside/ieak.template'; +$signup_html = -e 'signup.html' + ? 'signup.html' + : '/usr/local/freeside/signup.html'; +$success_html = -e 'success.html' + ? 'success.html' + : '/usr/local/freeside/success.html'; +$decline_html = -e 'decline.html' + ? 'decline.html' + : '/usr/local/freeside/decline.html'; + + +if ( -e $ieak_file ) { + my $ieak_txt = Text::Template::_load_text($ieak_file) + or die $Text::Template::ERROR; + $ieak_txt =~ /^(.*)$/s; #untaint the template source - it's trusted + $ieak_txt = $1; + $ieak_txt =~ s/\r//g; # don't double \r on old templates + $ieak_txt =~ s/\n/\r\n/g; + $ieak_template = new Text::Template ( TYPE => 'STRING', SOURCE => $ieak_txt ) + or die $Text::Template::ERROR; +} else { + $ieak_template = ''; +} + +$agentnum = ''; +if ( -e $signup_html ) { + my $signup_txt = Text::Template::_load_text($signup_html) + or die $Text::Template::ERROR; + $signup_txt =~ /^(.*)$/s; #untaint the template source - it's trusted + $signup_txt = $1; + $signup_template = new Text::Template ( TYPE => 'STRING', + SOURCE => $signup_txt, + DELIMITERS => [ '<%=', '%>' ] + ) + or die $Text::Template::ERROR; + if ( $signup_txt =~ + /<\s*INPUT TYPE="?hidden"?\s+NAME="?agentnum"?\s+VALUE="?(\d+)"?\s*>/si + ) { + $agentnum = $1; + } +} else { + #too much maintenance hassle to keep in this file + die "can't find ./signup.html or /usr/local/freeside/signup.html"; + #$signup_template = new Text::Template ( TYPE => 'STRING', + # SOURCE => &signup_default, + # DELIMITERS => [ '<%=', '%>' ] + # ) + # or die $Text::Template::ERROR; +} + +if ( -e $success_html ) { + my $success_txt = Text::Template::_load_text($success_html) + or die $Text::Template::ERROR; + $success_txt =~ /^(.*)$/s; #untaint the template source - it's trusted + $success_txt = $1; + $success_template = new Text::Template ( TYPE => 'STRING', + SOURCE => $success_txt, + DELIMITERS => [ '<%=', '%>' ], + ) + or die $Text::Template::ERROR; +} else { + $success_template = new Text::Template ( TYPE => 'STRING', + SOURCE => &success_default, + DELIMITERS => [ '<%=', '%>' ], + ) + or die $Text::Template::ERROR; +} + +if ( -e $decline_html ) { + my $decline_txt = Text::Template::_load_text($decline_html) + or die $Text::Template::ERROR; + $decline_txt =~ /^(.*)$/s; #untaint the template source - it's trusted + $decline_txt = $1; + $decline_template = new Text::Template ( TYPE => 'STRING', + SOURCE => $decline_txt, + DELIMITERS => [ '<%=', '%>' ], + ) + or die $Text::Template::ERROR; +} else { + $decline_template = new Text::Template ( TYPE => 'STRING', + SOURCE => &decline_default, + DELIMITERS => [ '<%=', '%>' ], + ) + or die $Text::Template::ERROR; +} + +$cgi = new CGI; + +$init_data = signup_info( 'agentnum' => $agentnum, + 'promo_code' => scalar($cgi->param('promo_code')), + 'reg_code' => uc(scalar($cgi->param('reg_code'))), + ); + +if ( ( defined($cgi->param('magic')) && $cgi->param('magic') eq 'process' ) + || ( defined($cgi->param('action')) && $cgi->param('action') eq 'process_signup' ) + ) { + + $error = ''; + + $cgi->param('agentnum', $agentnum) if $agentnum; + $cgi->param('reg_code', uc(scalar($cgi->param('reg_code'))) ); + + #false laziness w/agent.cgi, identical except for agentnum + my $payby = $cgi->param('payby'); + if ( $payby eq 'CHEK' || $payby eq 'DCHK' ) { + #$payinfo = join('@', map { $cgi->param( $payby. "_payinfo$_" ) } (1,2) ); + $cgi->param('payinfo' => $cgi->param($payby. '_payinfo1'). '@'. + $cgi->param($payby. '_payinfo2') + ); + } else { + $cgi->param('payinfo' => $cgi->param( $payby. '_payinfo' ) ); + } + $cgi->param('paydate' => $cgi->param( $payby. '_month' ). '-'. + $cgi->param( $payby. '_year' ) + ); + $cgi->param('payname' => $cgi->param( $payby. '_payname' ) ); + $cgi->param('paycvv' => defined $cgi->param( $payby. '_paycvv' ) + ? $cgi->param( $payby. '_paycvv' ) + : '' + ); + $cgi->param('paytype' => defined $cgi->param( $payby. '_paytype' ) + ? $cgi->param( $payby. '_paytype' ) + : '' + ); + $cgi->param('paystate' => defined $cgi->param( $payby. '_paystate' ) + ? $cgi->param( $payby. '_paystate' ) + : '' + ); + + if ( $cgi->param('invoicing_list') ) { + $cgi->param('invoicing_list' => $cgi->param('invoicing_list'). ', POST') + if $cgi->param('invoicing_list_POST'); + } else { + $cgi->param('invoicing_list' => 'POST' ); + } + + if ( $cgi->param('_password') ne $cgi->param('_password2') ) { + $error = $init_data->{msgcat}{passwords_dont_match}; #msgcat + $cgi->param('_password', ''); + $cgi->param('_password2', ''); + } + + if ( $payby =~ /^(CARD|DCRD)$/ && $cgi->param('CARD_type') ) { + my $payinfo = $cgi->param('payinfo'); + $payinfo =~ s/\D//g; + + $payinfo =~ /^(\d{13,16})$/ + or $error ||= $init_data->{msgcat}{invalid_card}; #. $self->payinfo; + $payinfo = $1; + validate($payinfo) + or $error ||= $init_data->{msgcat}{invalid_card}; #. $self->payinfo; + cardtype($payinfo) eq $cgi->param('CARD_type') + or $error ||= $init_data->{msgcat}{not_a}. $cgi->param('CARD_type'); + } + + if ($init_data->{emailinvoiceonly} && (length $cgi->param('invoicing_list') < 1)) { + $error ||= $init_data->{msgcat}{illegal_or_empty_text}; + } + + unless ( $error ) { + my $rv = new_customer( { + ( map { $_ => scalar($cgi->param($_)) } + qw( last first ss company + address1 address2 city county state zip country + daytime night fax stateid stateid_state + + ship_last ship_first 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 + invoicing_list referral_custnum promo_code reg_code + pkgpart username sec_phrase _password popnum refnum + agentnum + ), + grep { /^snarf_/ } $cgi->param + ), + 'payip' => $cgi->remote_host(), + } ); + $error = $rv->{'error'}; + } + #eslaf + + if ( $error eq '_decline' ) { + print_decline(); + } elsif ( $error ) { + #fudge the snarf info + no strict 'refs'; + ${$_} = $cgi->param($_) foreach grep { /^snarf_/ } $cgi->param; + print_form(); + } else { + print_okay( + 'pkgpart' => scalar($cgi->param('pkgpart')), + ); + } + +} else { + $error = ''; + print_form; +} + +sub print_form { + + $error = "Error: $error" if $error; + + my $r = { + $cgi->Vars, + %{$init_data}, + 'error' => $error, + }; + + $r->{pkgpart} ||= $r->{default_pkgpart}; + + $r->{referral_custnum} = $r->{'ref'}; + #$cgi->delete('ref'); + #$cgi->delete('init_popstate'); + $r->{self_url} = $cgi->self_url; + + print $cgi->header( '-expires' => 'now' ), + $signup_template->fill_in( PACKAGE => 'FS::SelfService::_signupcgi', + HASH => $r + ); +} + +sub print_decline { + print $cgi->header( '-expires' => 'now' ), + $decline_template->fill_in(); +} + +sub print_okay { + my %param = @_; + my $user_agent = new HTTP::BrowserDetect $ENV{HTTP_USER_AGENT}; + + $cgi->param('username') =~ /^(.+)$/ + or die "fatal: invalid username got past FS::SelfService::new_customer"; + my $username = $1; + $cgi->param('_password') =~ /^(.+)$/ + or die "fatal: invalid password got past FS::SelfService::new_customer"; + my $password = $1; + ( $cgi->param('first'). ' '. $cgi->param('last') ) =~ /^(.*)$/ + or die "fatal: invalid email_name got past FS::SelfService::new_customer"; + my $email_name = $1; #global for template + + #my %pop = (); + my %popnum2pop = (); + foreach ( @{ $init_data->{'svc_acct_pop'} } ) { + #push @{ $pop{ $_->{state} }->{ $_->{ac} } }, $_; + $popnum2pop{$_->{popnum}} = $_; + } + + my( $ac, $exch, $loc); + my $pop = $popnum2pop{$cgi->param('popnum')}; + #or die "fatal: invalid popnum got past FS::SelfService::new_customer"; + if ( $pop ) { + ( $ac, $exch, $loc ) = ( $pop->{'ac'}, $pop->{'exch'}, $pop->{'loc'} ); + } else { + ( $ac, $exch, $loc ) = ( '', '', ''); #presumably you're not using them. + } + + #global for template + my $part_pkg = ( grep { $_->{'pkgpart'} eq $param{'pkgpart'} } + @{ $init_data->{'part_pkg'} } + )[0]; + my $pkg = $part_pkg->{'pkg'}; + + if ( $ieak_template && $user_agent->windows && $user_agent->ie ) { + #send an IEAK config + print $cgi->header('application/x-Internet-signup'), + $ieak_template->fill_in(); + } else { #send a simple confirmation + print $cgi->header( '-expires' => 'now' ), + $success_template->fill_in( HASH => { + username => $username, + password => $password, + _password => $password, + email_name => $email_name, + ac => $ac, + exch => $exch, + loc => $loc, + pkg => $pkg, + part_pkg => \$part_pkg, + }); + } +} + +sub success_default { #html to use if you don't specify a success file + <<'END'; +Signup successful +Signup successful

    +Thanks for signing up! +

    +Signup information for <%= $email_name %>: +

    +Username: <%= $username %>
    +Password: <%= $password %>
    +Access number: (<%= $ac %>) / <%= $exch %> - <%= $local %>
    +Package: <%= $pkg %>
    + +END +} + +sub decline_default { #html to use if there is a decline + <<'END'; +Processing error +Processing error

    +There has been an error processing your account. Please contact customer +support. + +END +} + +# subs for the templates... + +package FS::SelfService::_signupcgi; +use HTML::Entities; +use FS::SelfService qw(regionselector expselect popselector); + diff --git a/fs_selfservice/FS-SelfService/cgi/signup.html b/fs_selfservice/FS-SelfService/cgi/signup.html new file mode 100755 index 000000000..42334eade --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/signup.html @@ -0,0 +1,382 @@ +<%= $agent || 'ISP' %> Signup form + + +<%= $agent || 'ISP' %> Signup form

    +<%= $error %> +
    + + + + + +<%= + $OUT = join("\n",map { my $method = $_ ; map { qq|| } qw / payinfo payinfo1 payinfo2 payname paystate paytype paycvv month year type / } @payby); +%> + +<%= + $OUT = join("\n", map { qq|| } qw / promo_code reg_code pkgpart username _password _password2 sec_phrase popnum / ); +%> + +Where did you hear about our service?

    +Contact Information + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +<%= + $OUT = ''; + if ( $stateid_enabled ) { + my ($county_html, $state_html, $country_html) = + regionselector( { + prefix => 'stateid_', + default_state => $statedefault, + default_country => $countrydefault, + locales => \@cust_main_county, + } ); + $OUT .= qq!'; + $OUT .= qq!!; + $OUT .= qq!'; + $OUT .=""; + } +%> +
    *Contact name
    (last, first)
    , +
    Company
    *Address
     
    *City*State/Country + <%= + ($county_html, $state_html, $country_html) = + regionselector( { + selected_county => $county, + selected_state => $state, + selected_country => $country, + default_state => $statedefault, + default_country => $countrydefault, + locales => \@cust_main_county, + } ); + + "$county_html $state_html"; + %> + *Zip
    *Country<%= $country_html %>
    Day Phone
    Night Phone
    Fax
    !. $label{stateid}.'!. $label{stateid_state} .'$county_html $state_html
    * required fields
    +
    Billing information + + +<%= ( scalar(@payby) > 1 or 1 ) ? '!; + } + } + if ( $paystate_enabled ) { + foreach my $payby ( grep { exists $payby{$_} } qw(CHEK DCHK) ) { + my ($county_html, $state_html, $country_html) = + regionselector( { + prefix => "${payby}_pay", + default_state => $statedefault, + default_country => $countrydefault, + locales => \@cust_main_county, + } ); + $payby{$payby} .= "
    ${r}Bank state $county_html $state_html"; + } + } + + my( $account, $aba ) = split('@', $payinfo); + my %paybychecked = ( + 'CARD' => qq!
    + + <%= + $OUT =''; + unless ( $emailinvoiceonly ) { + $OUT .= ' + + +
    <%= $OUT = ( $emailinvoiceonly ? q|*| : q|| ) %> Email invoice +
    Billing type ' : '' %> + + + <%= + + my $cardselect = ''; + + my %payby = ( + 'CARD' => qq!Credit card
    *$cardselect
    *Exp !. expselect("CARD"). qq!
    *Name on card
    !, + 'DCRD' => qq!Credit card
    *$cardselect
    *Exp !. expselect("DCRD"). qq!
    *Name on card
    !, + 'CHEK' => qq!Electronic check
    ${r}Account number
    ${r}ABA/Routing code Type
    {$r}Bank State
    ${r}Bank name !, + 'DCHK' => qq!Electronic check
    ${r}Account number Type
    ${r}ABA/Routing code
    {$r}Bank State
    ${r}Bank name !, + 'LECB' => qq!Phone bill billing
    ${r}Phone number !, + 'BILL' => qq!Billing
    P.O.
    *Exp !. expselect("BILL", "12-2037"). qq!
    *Attention
    !, + 'COMP' => qq!Complimentary
    *Approved by
    *Exp !. expselect("COMP"), + 'PREPAY' => qq!Prepaid card
    *!, + ); + + if ( $cvv_enabled ) { + foreach my $payby ( grep { exists $payby{$_} } qw(CARD DCRD) ) { #1.4/1.5 + $payby{$payby} .= qq!
    CVV2 (help)
    !, + 'DCRD' => qq!Credit card
    *$cardselect
    *Exp !. expselect("DCRD", $paydate). qq!
    *Name on card
    !, + 'CHEK' => qq!Electronic check
    ${r}Account number Type
    ${r}ABA/Routing code
    ${r}Bank name !, + 'DCHK' => qq!Electronic check
    ${r}Account number Type
    ${r}ABA/Routing code
    ${r}Bank name !, + 'LECB' => qq!Phone bill billing
    ${r}Phone number !, + 'BILL' => qq!Billing
    P.O.
    *Exp !. expselect("BILL", $paydate). qq!
    *Attention
    !, + 'COMP' => qq!Complimentary
    *Approved by
    *Exp !. expselect("COMP", $paydate), + 'PREPAY' => qq!Prepaid card
    *!, + ); + + if ( $cvv_enabled ) { + foreach my $payby ( grep { exists $payby{$_} } qw(CARD DCRD) ) { #1.4/1.5 + $paybychecked{$payby} .= qq!!; + } + } + if ( $paystate_enabled ) { + foreach my $payby ( grep { exists $payby{$_} } qw(CHEK DCHK) ) { + my ($county_html, $state_html, $country_html) = + regionselector( { + prefix => "${payby}_pay", + selected_county => $county, + selected_state => $state, + selected_country => $country, + default_state => $statedefault, + default_country => $countrydefault, + locales => \@cust_main_county, + } ); + $paybychecked{$payby} .= "
    ${r}Bank state $county_html $state_html"; + } + } + +use Tie::IxHash; +use HTML::Widgets::SelectLayers; + + my %payby_index = ( 'CARD' => qq/Credit Card/, + 'DCRD' => qq/Credit Card/, + 'CHEK' => qq/Check/, + 'DCHK' => qq/Check/, + 'LECB' => qq/Phone Bill Billing/, + 'BILL' => qq/Billing/, + 'COMP' => qq/Complimentary/, + 'PREPAY' => qq/Prepaid Card/, + ); + + +tie my %options, 'Tie::IxHash', (); + +foreach my $payby_option ( @payby ) { + $options{$payby_option} = $payby_index{$payby_option}; +} + +HTML::Widgets::SelectLayers->new( + options => \%options, + selected_layer => 'CARD', + form_name => 'dummy', + html_between => '
    * Card type$cardselect
    * Card number
    * Expration!. expselect("CARD", $paydate). qq!
    * Name on card
    CVV2 (help)
    ', + form_action => 'dummy.cgi', + layer_callback => sub { my $layer = shift; return $paybychecked{$layer}. ''; }, +)->html; + + + %> + +* required fields +

    First package + + + + + + + + + + + + + + + + + + +<%= + if ( $security_phrase ) { + $OUT .= < + + + +ENDOUT + } else { + $OUT .= ''; + } +%> +<%= + if ( @svc_acct_pop ) { + $OUT .= ''; + } else { + $OUT .= popselector(popnum=>$popnum, pops=>\@svc_acct_pop); + } +%> +
    Username
    Password
    Re-enter Password
    Security Phrase +
    Access number'. + popselector( 'popnum' => $popnum, + 'pops' => \@svc_acct_pop, + 'init_popstate' => $init_popstate, + 'popac' => $popac, + 'acstate' => $acstate, + ). + '
    + +<%= +if ( @optional_packages ) { + my @html; + foreach my $ii ( 0 .. $#optional_packages) { + my $friendly_index = $ii + 1; + if ($optional_packages[$ii]) { + push @html, qq|
    Optional Package #$friendly_index
    |,'
    '; + + push @html, qq||; + + push @html, '
    '; + } + $OUT = join("\n", @html); + } +} else { +$OUT = '' +} +%> + +
    + +
    diff --git a/fs_selfservice/FS-SelfService/cgi/stateselect.html b/fs_selfservice/FS-SelfService/cgi/stateselect.html new file mode 100644 index 000000000..ba55bff74 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/stateselect.html @@ -0,0 +1,134 @@ +ISP Signup +ISP Signup - state selection

    + +
    +Select your state from the map or dropdown: + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    + +
    + + diff --git a/fs_selfservice/FS-SelfService/cgi/success-delayed.html b/fs_selfservice/FS-SelfService/cgi/success-delayed.html new file mode 100644 index 000000000..5eeed5957 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/success-delayed.html @@ -0,0 +1,16 @@ +Signup successful +Signup successful

    +Thanks for signing up! +

    +Signup information for <%= $email_name %>: +

    +Username: <%= $username %>
    +Password: <%= $password %>
    +Access number: (<%= $ac %>) / <%= $exch %> - <%= $local %>
    +Package: <%= $pkg %>
    +Charge: <%= sprintf('$%.2f', $part_pkg->{'options'}->{'setup_fee'}) %>
    +In <%= $part_pkg->{'options'}->{'free_days'} %> days you will be charged + <%= sprintf('$%.2f', $part_pkg->{'options'}->{'recur_fee'}) %> +and <%= $part_pkg->{'freq_pretty'} %> thereafter.
    + + diff --git a/fs_selfservice/FS-SelfService/cgi/success.html b/fs_selfservice/FS-SelfService/cgi/success.html new file mode 100644 index 000000000..397cc6c30 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/success.html @@ -0,0 +1,11 @@ +Signup successful +Signup successful

    +Thanks for signing up! +

    +Signup information for <%= $email_name %>: +

    +Username: <%= $username %>
    +Password: <%= $password %>
    +Access number: (<%= $ac %>) / <%= $exch %> - <%= $local %>
    +Package: <%= $pkg %>
    + diff --git a/fs_selfservice/FS-SelfService/cgi/svc_acct.html b/fs_selfservice/FS-SelfService/cgi/svc_acct.html new file mode 100644 index 000000000..00244386b --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/svc_acct.html @@ -0,0 +1,58 @@ +Setup <%= $svc %>

    + +<%= if ( $error ) { + $OUT .= qq!Error setting up $svc: $error!. + '

    '; +} ''; %> +
    + + + + + + + + + + +<%= + $OUT .= domainselector(pkgnum=>$pkgnum, svcpart=>$svcpart); +%> + + + + + + + + +<%= + if ( $security_phrase ) { + $OUT .= < + + + +ENDOUT + } else { + $OUT .= ''; + } +%> +<%= + if ( @svc_acct_pop ) { + $OUT .= ''; + } else { + $OUT .= popselector(popnum=>$popnum, pops=>\@svc_acct_pop); + } +%> +
    Username
    Password
    Re-enter Password
    Security Phrase +
    Access number'. + popselector( 'popnum' => $popnum, + 'pops' => \@svc_acct_pop, + 'init_popstate' => $init_popstate, + 'popac' => $popac, + 'acstate' => $acstate, + ). + '
    + +
    diff --git a/fs_selfservice/FS-SelfService/cgi/view_customer.html b/fs_selfservice/FS-SelfService/cgi/view_customer.html new file mode 100644 index 000000000..11e4432d0 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/view_customer.html @@ -0,0 +1,29 @@ +Reseller +Reseller

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> + +<%= include('agent_menu') %> +
    + +<%= $message + ? "$message

    " + : '' +%> + +<%= $small_custview %> + +
    + + +<%= include('agent_customer_menu') %> +
    + +
    + +
    +
    +powered by freeside + + + + diff --git a/fs_selfservice/FS-SelfService/cgi/view_invoice.html b/fs_selfservice/FS-SelfService/cgi/view_invoice.html new file mode 100644 index 000000000..ad2f4f419 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/view_invoice.html @@ -0,0 +1,15 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + + +<%= $invoice_html %> + + +
    +powered by freeside + + + + diff --git a/fs_selfservice/FS-SelfService/cgi/view_support_details.html b/fs_selfservice/FS-SelfService/cgi/view_support_details.html new file mode 100644 index 000000000..270f9a81d --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/view_support_details.html @@ -0,0 +1,80 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + + +Support usage details for +<%= Date::Format::time2str('%b %o %Y', $beginning) %> - +<%= Date::Format::time2str('%b %o %Y', $ending) %> +

    + +<%= if ( $error ) { + $OUT .= qq!$error

    !; +} ''; %> + + + + + + +
    +<%= if ($previous < $beginning) { + $OUT .= qq!Previous period!; + }else{ + ''; + } %> + +<%= if ($next > $ending) { + $OUT .= qq!Next period!; + }else{ + ''; + }%> +
    + + + + + + + + + +<%= my $total = 0; + foreach my $usage ( @usage ) { + $OUT .= ''; + } + my $h = int($total/3600); + my $m = sprintf("%02d", int(($total % 3600) / 60)); + my $s = sprintf("%02d", $total % 60); + $OUT .= qq!!; + $OUT .= qq!!; + %> + +
    TicketSubjectStaffDateStatusTime
    '; + $OUT .= $usage->{'ticketid'}; + $OUT .= ''; + $OUT .= $usage->{'subject'}; + $OUT .= ''; + $OUT .= $usage->{'creator'}; + $OUT .= ''; + $OUT .= Date::Format::time2str('%T%P %a %b %o %Y', $usage->{'_date'}); + $OUT .= ''; + $OUT .= $usage->{'status'}; + $OUT .= ''; + my $duration = $usage->{'support'}; + $total += $usage->{'support'}; + my $h = int($duration/3600); + my $m = sprintf("%02d", int(($duration % 3600) / 60)); + my $s = sprintf("%02d", $duration % 60); + $OUT .= $usage->{'support'} < 0 ? '-' : ''; + $OUT .= "$h:$m:$s"; + $OUT .= '

    $h:$m:$s
    +
    + + +
    +powered by freeside + diff --git a/fs_selfservice/FS-SelfService/cgi/view_usage.html b/fs_selfservice/FS-SelfService/cgi/view_usage.html new file mode 100644 index 000000000..79d07d4df --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/view_usage.html @@ -0,0 +1,59 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + + +Service usage

    + +<%= if ( $error ) { + $OUT .= qq!$error

    !; +} ''; %> + + + + + + + + + +<%= foreach my $svc ( @svcs ) { + my $link = "${url}view_usage_details;". + "svcnum=$svc->{'svcnum'};beginning=0;ending=0"; + $OUT .= ''; + if ( $svc->{'recharge_amount'} ) { + my $link = "${url}process_order_recharge;". + "svcnum=$svc->{'svcnum'}"; + $OUT .= ''; + } + } %> + +
    AccountTime remainingUpload remainingDownload remainingTotal remaining
    '; + $OUT .= qq!!. $svc->{'label'}. ': '. $svc->{'value'}.''; + $OUT .= ''; + $OUT .= $svc->{'seconds'}; + $OUT .= ''; + $OUT .= $svc->{'upbytes'}; + $OUT .= ''; + $OUT .= $svc->{'downbytes'}; + $OUT .= ''; + $OUT .= $svc->{'totalbytes'}; + $OUT .= '
    '; + $OUT .= qq!!.'Recharge for $'; + $OUT .= $svc->{'recharge_amount'} . ' with'; + $OUT .= ''; + $OUT .= $svc->{'recharge_seconds'} if $svc->{'recharge_seconds'}; + $OUT .= ''; + $OUT .= $svc->{'recharge_upbytes'} if $svc->{'recharge_upbytes'}; + $OUT .= ''; + $OUT .= $svc->{'recharge_downbytes'} if $svc->{'recharge_downbytes'}; + $OUT .= ''; + $OUT .= $svc->{'recharge_totalbytes'} if $svc->{'recharge_totalbytes'}; + $OUT .= '
    +
    + + +
    +powered by freeside + diff --git a/fs_selfservice/FS-SelfService/cgi/view_usage_details.html b/fs_selfservice/FS-SelfService/cgi/view_usage_details.html new file mode 100644 index 000000000..74a4c3d12 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/view_usage_details.html @@ -0,0 +1,86 @@ +MyAccount +MyAccount

    +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<%= include('myaccount_menu') %> + + +Service usage details for +<%= Date::Format::time2str('%b %o %Y', $beginning) %> - +<%= Date::Format::time2str('%b %o %Y', $ending) %> +

    + +<%= if ( $error ) { + $OUT .= qq!$error

    !; +} ''; %> + + + + + + +
    +<%= if ($previous < $beginning) { + $OUT .= qq!Previous period!; + }else{ + ''; + } %> + +<%= if ($next > $ending) { + $OUT .= qq!Next period!; + }else{ + ''; + }%> +
    + + + + + + + + +<%= my $total = 0; + my $utotal = 0; + my $dtotal = 0; + foreach my $usage ( @usage ) { + $OUT .= ''; + } + my $h = int($total/3600); + my $m = sprintf("%02d", int(($total % 3600) / 60)); + my $s = sprintf("%02d", $total % 60); + $OUT .= qq!!; + $OUT .= qq!! x 3; + $OUT .= qq!!; + $OUT .= qq!!; + $OUT .= qq!!; + $OUT .= qq!!; + $OUT .= qq!!; %> + +
    AccountStart TimeDurationUploadDownload
    '; + $OUT .= $usage->{'username'}; + $OUT .= ''; + $OUT .= Date::Format::time2str('%T%P %a %b %o %Y', $usage->{'acctstarttime'}); + $OUT .= ''; + my $duration = $usage->{'acctstoptime'} - $usage->{'acctstarttime'}; + $total += $duration; + my $h = int($duration/3600); + my $m = sprintf("%02d", int(($duration % 3600) / 60)); + my $s = sprintf("%02d", $duration % 60); + $OUT .= "$h:$m:$s"; + $OUT .= ''; + $OUT .= Number::Format::format_bytes($usage->{'acctinputoctets'}, precision => 2); + $utotal += $usage->{'acctinputoctets'}; + $OUT .= ''; + $OUT .= Number::Format::format_bytes($usage->{'acctoutputoctets'}, precision => 2); + $dtotal += $usage->{'acctoutputoctets'}; + $OUT .= '

    $h:$m:$s!; + $OUT .= Number::Format::format_bytes($utotal, precision => 2). qq!!; + $OUT .= Number::Format::format_bytes($dtotal, precision => 2). qq!
    +
    + + +
    +powered by freeside + diff --git a/fs_selfservice/FS-SelfService/cgi/xmlrpc.cgi b/fs_selfservice/FS-SelfService/cgi/xmlrpc.cgi new file mode 100644 index 000000000..559ae04d8 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/xmlrpc.cgi @@ -0,0 +1,18 @@ +#!/usr/bin/perl -Tw + +use strict; +use XMLRPC::Transport::HTTP; +use XMLRPC::Lite; # for XMLRPC::Serializer +use FS::SelfService::XMLRPC; + +my %typelookup = ( + base64 => [10, sub {$_[0] =~ /[^\x09\x0a\x0d\x20-\x7f]/}, 'as_base64'], + dateTime => [35, sub {$_[0] =~ /^\d{8}T\d\d:\d\d:\d\d$/}, 'as_dateTime'], + string => [40, sub {1}, 'as_string'], +); +my $serializer = new XMLRPC::Serializer(typelookup => \%typelookup); + +XMLRPC::Transport::HTTP::CGI->dispatch_to('FS::SelfService::XMLRPC') + ->serializer($serializer) + ->handle; + diff --git a/fs_selfservice/FS-SelfService/freeside-selfservice-clientd b/fs_selfservice/FS-SelfService/freeside-selfservice-clientd new file mode 100644 index 000000000..bdc8e1547 --- /dev/null +++ b/fs_selfservice/FS-SelfService/freeside-selfservice-clientd @@ -0,0 +1,272 @@ +#!/usr/bin/perl -w +# +# freeside-selfservice-clientd +# +# This is run REMOTELY over ssh by freeside-selfservice-server + +use strict; +use subs qw(spawn logmsg lock_write unlock_write); +use Fcntl qw(:flock); +use POSIX qw(:sys_wait_h); +use Socket; +use Storable 2.09 qw(nstore_fd fd_retrieve); +use IO::Handle qw(_IONBF); +use IO::Select; +use IO::File; + +#STDOUT->setbuf(''); + +my $tag = scalar(@ARGV) ? '.'.shift : ''; + +use vars qw( $Debug ); +$Debug = 2; #2 will turn on child logging + #3 will log packet contents,#including passwords + #4 will log receipts of all packets from server including + # keepalives (big!) + +my $socket = "/usr/local/freeside/selfservice_socket$tag"; +my $pid_file = "$socket.pid"; + +my $log_file = "/usr/local/freeside/selfservice$tag.log"; + +my $lock_file = "/usr/local/freeside/selfservice$tag.writelock"; + +#my $me = '[client]'; + +$|=1; + +$SIG{__WARN__} = \&_logmsg; + +#read data to be cached or something +#warn "$me Reading init data\n" if $Debug; +#my $signup_init = + +warn "Creating $lock_file\n" if $Debug; +open(LOCKFILE,">$lock_file") or die "can't open $lock_file: $!"; +close LOCKFILE; + +warn "Creating $socket\n" if $Debug; +my $uaddr = sockaddr_un($socket); +my $proto = getprotobyname('tcp'); +socket(Server,PF_UNIX,SOCK_STREAM,0) or die "socket: $!"; +unlink($socket); +bind(Server, $uaddr) or die "bind: $!"; +listen(Server,SOMAXCONN) or die "listen: $!"; + +if ( -e $pid_file ) { + open(PIDFILE,"<$pid_file"); + my $old_pid = ; + close PIDFILE; + if ( $old_pid =~ /^(\d+)$/ ) { + kill 'TERM', $1; + } +} +open(PIDFILE,">$pid_file"); +print PIDFILE "$$\n"; +close PIDFILE; + +#my $waitedpid; +#sub REAPER { $waitedpid = wait; $SIG{CHLD} = \&REAPER; } +#$SIG{CHLD} = \&REAPER; + +warn "enabling keep alives\n" if $Debug; +nstore_fd( { _packet => '_enable_keepalive' } , \*STDOUT ); + +warn "entering main loop\n" if $Debug; + +my %kids; + +my $s = new IO::Select; +$s->add(\*STDIN); +$s->add(\*Server); + +#for ( $waitedpid = 0; +# accept(Client,Server) || $waitedpid; +# $waitedpid = 0, close Client) +#{ +# next if $waitedpid; + +#$SIG{PIPE} = sub { warn "SIGPIPE received" }; +#$SIG{CHLD} = sub { warn "SIGCHLD received" }; + +#sub REAPER { warn "SIGCHLD received"; my $pid = wait; $SIG{CHLD} = \&REAPER; } +#sub REAPER { my $pid = wait; $SIG{CHLD} = \&REAPER; } +#sub REAPER { my $pid = wait; delete $kids{$pid}; $SIG{CHLD} = \&REAPER; } +#$SIG{CHLD} = \&REAPER; + +my $undisp = 0; +while (1) { + + &reap_kids; + + warn "waiting for connection\n" if $Debug && !$undisp; + + #my @handles = $s->can_read(); + my @handles = $s->can_read(5); + $undisp = !scalar(@handles); + foreach my $handle ( @handles ) { + + if ( $handle == \*STDIN ) { + + warn "receiving packet from server\n" if $Debug > 3; + + my $packet = fd_retrieve(\*STDIN); + my $token = $packet->{'_token'}; + + if ( $token eq '_keepalive' ) { + $undisp = 1; + next; + } + + warn "received packet from server with token $token\n". + ( $Debug > 2 + ? join('', map { " $_=>$packet->{$_}\n" } keys %$packet ) + : '' ) + if $Debug; + + if ( exists($kids{$token}) ) { + warn "sending return packet to $token via $kids{$token}\n" + if $Debug; + nstore_fd($packet, $kids{$token}); + warn "flushing to $token\n" if $Debug; + until ( $kids{$token}->flush ) { + warn "WARNING: error flushing: $!"; + sleep 1; + } + #no close or delete here - will block waiting for child + warn "done with $token\n" if $Debug; + } else { + warn "WARNING: unknown token $token, discarding message"; + } + + } elsif ( $handle == \*Server ) { + + until ( accept(Client, Server) ) { + warn "WARNING: accept failed: $!"; + next; + } + + warn "received local connection; forking\n" if $Debug; + + spawn sub { #child + warn "[child-$$] reading packet from local client" if $Debug > 1; + my $packet = fd_retrieve(\*Client); + warn "[child-$$] packet received:\n". + join('', map { " $_=>$packet->{$_}\n" } keys %$packet ) + if $Debug > 2; + my $command = $packet->{'command'}; + #handle some commands weirdly? + $packet->{_token}=$$; + + warn "[child-$$] locking write stream\n" if $Debug > 1; + lock_write; + + warn "[child-$$] sending packet to remote server\n" if $Debug > 1; + nstore_fd($packet, \*STDOUT) or die "FATAL: can't send response: $!"; + + warn "[child-$$] flushing write stream\n" if $Debug > 1; + STDOUT->flush or die "FATAL: can't flush: $!"; + + warn "[child-$$] releasing write lock\n" if $Debug > 1; + unlock_write; + + warn "[child-$$] closing write stream\n" if $Debug > 1; + close STDOUT or die "FATAL: can't close write stream: $!"; #??! + + warn "[child-$$] waiting for response from parent\n" if $Debug > 1; + my $w = new IO::Select; + $w->add(\*STDIN); + until ( $w->can_read ) { + warn "[child-$$] WARNING: interrupted select: $!\n"; + } + my $rv = fd_retrieve(\*STDIN); + + #close STDIN; + + warn "[child-$$] sending response to local client" if $Debug > 1; + nstore_fd($rv, \*Client); + Client->flush or die "FATAL: can't flush to local client: $!"; + close Client or die "FATAL: can't close connection to local client: $!"; + + warn "[child-$$] child exiting" if $Debug > 1; + exit; + + }; #eo child + + #close Client; + + } else { + die "wtf? $handle"; + } + + } + +} + +sub reap_kids { + #warn "reaping kids\n"; + foreach my $pid ( keys %kids ) { + my $kid = waitpid($pid, WNOHANG); + if ( $kid > 0 ) { + close $kids{$kid}; + delete $kids{$kid}; + } + } + #warn "done reaping\n"; +} + +sub spawn { + my $coderef = shift; + + unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') { + use Carp; + confess "usage: spawn CODEREF"; + } + + my $pid; + #if (!defined($pid = fork)) { + my $kid = new IO::Handle; + if (!defined($pid = open($kid, '|-'))) { + warn "WARNING: cannot fork: $!"; + return; + } elsif ($pid) { + warn "begat $pid" if $Debug; + $kids{$pid} = $kid; + #$kids{$pid}->autoflush; + return; # I'm the parent + } + # else I'm the child -- go spawn + +# open(STDIN, "<&Client") || die "can't dup client to stdin"; +# open(STDOUT, ">&Client") || die "can't dup client to stdout"; +# open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr"; + exit &$coderef(); +} + +sub _logmsg { + chomp( my $msg = shift ); + my $log = new IO::File ">>$log_file"; + die "can't open $log_file: $!" unless defined($log); + flock($log, LOCK_EX); + seek($log, 0, 2); + print $log "[client] [". scalar(localtime). "] [$$] $msg\n"; + flock($log, LOCK_UN); + close $log; +} + +sub lock_write { + #broken on freebsd? + #flock(STDOUT, LOCK_EX) or die "FATAL: can't lock write stream: $!"; + + #open a new one for each kid to get a unique lock + open(LOCKFILE,">$lock_file") or die "can't open $lock_file: $!"; + + flock(LOCKFILE, LOCK_EX) or die "FATAL: can't lock $lock_file: $!"; +} + +sub unlock_write { + #broken on freebsd? + #flock(STDOUT, LOCK_UN) or die "FATAL: can't release write lock: $!"; + + flock(LOCKFILE, LOCK_UN) or die "FATAL: can't unlock $lock_file: $!"; +} diff --git a/fs_selfservice/FS-SelfService/freeside-selfservice-xmlrpc-server b/fs_selfservice/FS-SelfService/freeside-selfservice-xmlrpc-server new file mode 100644 index 000000000..bd4f83b3c --- /dev/null +++ b/fs_selfservice/FS-SelfService/freeside-selfservice-xmlrpc-server @@ -0,0 +1,59 @@ +#!/usr/bin/perl -w +# +# freeside-selfservice-xmlrpc-server +# + +use strict; +use Fcntl qw(:flock); +use POSIX; +use Getopt::Std; +use XMLRPC::Transport::HTTP; +use XMLRPC::Lite; # for XMLRPC::Serializer; +use FS::SelfService::XMLRPC; + +use vars qw( $opt_p $opt_d ); +use vars qw( $DEBUG ); + +getopts("p:d"); +$DEBUG = $opt_d; +my $tag = $opt_p ? ':'.$opt_p : ''; + +my %typelookup = ( + base64 => [10, sub {$_[0] =~ /[^\x09\x0a\x0d\x20-\x7f]/}, 'as_base64'], + dateTime => [35, sub {$_[0] =~ /^\d{8}T\d\d:\d\d:\d\d$/}, 'as_dateTime'], + string => [40, sub {1}, 'as_string'], +); +my $serializer = new XMLRPC::Serializer(typelookup => \%typelookup); + +my $log_file = "/usr/local/freeside/selfservice.xmlrpc$tag.log"; + +my $pid = fork; +defined($pid) or die "Can't fork to start: $!"; +print "Started daemon with pid $pid\n" if $pid; +exit if $pid; + +POSIX::setsid(); +open STDIN, "/dev/null" or die "Can't get rid of STDIN"; +open STDOUT, ">/dev/null" or die "Can't get rid of STDOUT"; +open STDERR, ">&STDOUT" or die "Can't get rid of STDERR"; + +$SIG{__WARN__} = \&_logmsg; +$SIG{__DIE__} = sub { &_logmsg(@_); exit }; + +my $daemon = XMLRPC::Transport::HTTP::Daemon + ->new(LocalPort => $opt_p ? $opt_p : 8080) + ->dispatch_to('FS::SelfService::XMLRPC') + ->serializer($serializer); + +warn "Handling request at ", $daemon->url, "\n"; +$daemon->handle; + +sub _logmsg { + chomp( my $msg = shift ); + my $log = new IO::File ">>$log_file"; + flock($log, LOCK_EX); + seek($log, 0, 2); + print $log "[". scalar(localtime). "] [$$] $msg\n"; + flock($log, LOCK_UN); + close $log; +} diff --git a/fs_selfservice/FS-SelfService/ieak.template b/fs_selfservice/FS-SelfService/ieak.template new file mode 100755 index 000000000..52edaa951 --- /dev/null +++ b/fs_selfservice/FS-SelfService/ieak.template @@ -0,0 +1,40 @@ +[Entry] +Entry_Name = The Internet +[Phone] +Dial_As_Is=no +Phone_Number = { $exch. $loc } +Area_Code = { $ac } +Country_Code = 1 +Country_Id = 1 +[Server] +Type = PPP +SW_Compress = Yes +PW_Encrypt = Yes +Negotiate_TCP/IP = Yes +Disable_LCP = No +[TCP/IP] +Specify_IP_Address = No +Specity_Server_Address = No +IP_Header_Compress = Yes +Gateway_On_Remote = Yes +[User] +Name = { $username } +Password = { $password } +Display_Password = Yes +[Internet_Mail] +Email_Name = { $email_name } +Email_Address = { $username }\@domain.tld +POP_Server = mail.domain.tld +POP_Server_Port_Number = 110 +POP_Login_Name = { $username } +POP_Login_Password = { $password } +SMTP_Server = mail.domain.tld +SMTP_Server_Port_Number = 25 +Install_Mail = 1 +[Internet_News] +NNTP_Server = news.domain.tld +NNTP_Server_Port_Number = 119 +Logon_Required = No +Install_News = 1 +[Branding] +Window_Title = The Internet diff --git a/fs_selfservice/FS-SelfService/test.pl b/fs_selfservice/FS-SelfService/test.pl new file mode 100644 index 000000000..7468ea471 --- /dev/null +++ b/fs_selfservice/FS-SelfService/test.pl @@ -0,0 +1,17 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### + +# change 'tests => 1' to 'tests => last_test_to_print'; + +use Test; +BEGIN { plan tests => 1 }; +use FS::SelfService; +ok(1); # If we made it this far, we're ok. + +######################### + +# Insert your test code below, the Test module is use()ed here so read +# its man page ( perldoc Test ) for help writing this test script. + diff --git a/fs_selfservice/fs_passwd_test b/fs_selfservice/fs_passwd_test new file mode 100755 index 000000000..4f8b8a888 --- /dev/null +++ b/fs_selfservice/fs_passwd_test @@ -0,0 +1,19 @@ +#!/usr/bin/perl -w + +use strict; +use FS::SelfService qw(passwd); + +my $rv = passwd( + 'username' => 'ivan', + 'old_password' => 'heyhoo', + 'new_password' => 'haloo', +); +my $error = $rv->{error}; + +if ( $error eq 'Incorrect password.' ) { + exit; +} else { + die $error if $error; + die "no error"; +} + diff --git a/fs_selfservice/php/freeside.class.php b/fs_selfservice/php/freeside.class.php new file mode 100644 index 000000000..21e89b47f --- /dev/null +++ b/fs_selfservice/php/freeside.class.php @@ -0,0 +1,33 @@ +URL); + + $request = xmlrpc_encode_request("FS.SelfService.XMLRPC.$name", $arguments); + $context = stream_context_create( array( 'http' => array( + 'method' => "POST", + 'header' => "Content-Type: text/xml", + 'content' => $request + ))); + $file = file_get_contents($this->URL, false, $context); + $response = xmlrpc_decode($file); + if (xmlrpc_is_fault($response)) { + trigger_error("[FreesideSelfService] XML-RPC communication error: $response[faultString] ($response[faultCode])"); + } else { + //error_log("[FreesideSelfService] $response"); + return $response; + } + } + +} + +?> diff --git a/fs_selfservice/php/freeside.login_example.php b/fs_selfservice/php/freeside.login_example.php new file mode 100644 index 000000000..69174a40a --- /dev/null +++ b/fs_selfservice/php/freeside.login_example.php @@ -0,0 +1,37 @@ +login( array( + 'username' => strtolower($_POST['username']), + 'domain' => $domain, + 'password' => strtolower($_POST['password']), +) ); + +error_log("[login] received response from freeside: $response"); +$error = $response['error']; + +if ( ! $error ) { + + // sucessful login + + $session_id = $response['session_id']; + + error_log("[login] logged into freeside with session_id=$session_id"); + + // store session id in your session store, to be used for other calls + +} else { + + // unsucessful login + + error_log("[login] error logging into freeside: $error"); + + // display error message to user + +} + +?> diff --git a/fs_selfservice/php/freeside_signup_example.php b/fs_selfservice/php/freeside_signup_example.php new file mode 100644 index 000000000..8b1dc193c --- /dev/null +++ b/fs_selfservice/php/freeside_signup_example.php @@ -0,0 +1,49 @@ +new_customer( array( + 'agentnum' => 1, + + 'first' => $_POST['first'], + 'last' => $_POST['last'], + 'address1' => $_POST['address1'], + 'address2' => $_POST['address2'], + 'city' => $_POST['city'], + 'state' => $_POST['state'], + 'zip' => $_POST['zip'], + 'country' => 'US', + 'daytime' => $_POST['daytime'], + 'fax' => $_POST['fax'], + + 'payby' => 'BILL', + 'invoicing_list' => $_POST['email'], + + 'pkgpart' => 2, + 'username' => strtolower($_POST['username']), + '_password' => strtolower($_POST['password']) +) ); + +error_log("[new_customer] received response from freeside: $response"); +$error = $response['error']; + +if ( ! $error ) { + + // sucessful signup + + $custnum = $response['custnum']; + + error_log("[new_customer] signup up with custnum $custnum"); + +} else { + + // unsucessful signup + + error_log("[new_customer] signup error:: $error"); + + // display error message to user + +} + +?> diff --git a/fs_sesmon/FS-SessionClient/Changes b/fs_sesmon/FS-SessionClient/Changes new file mode 100644 index 000000000..390a7b946 --- /dev/null +++ b/fs_sesmon/FS-SessionClient/Changes @@ -0,0 +1,5 @@ +Revision history for Perl extension FS::SessionClient + +0.01 Wed Oct 18 16:34:36 1999 + - original version; created by ivan 1.0 + diff --git a/fs_sesmon/FS-SessionClient/MANIFEST b/fs_sesmon/FS-SessionClient/MANIFEST new file mode 100644 index 000000000..162d4e453 --- /dev/null +++ b/fs_sesmon/FS-SessionClient/MANIFEST @@ -0,0 +1,11 @@ +Changes +MANIFEST +MANIFEST.SKIP +Makefile.PL +SessionClient.pm +test.pl +fs_sessiond +cgi/login.cgi +cgi/logout.cgi +bin/freeside-login +bin/freeside-logout diff --git a/fs_sesmon/FS-SessionClient/MANIFEST.SKIP b/fs_sesmon/FS-SessionClient/MANIFEST.SKIP new file mode 100644 index 000000000..ae335e78a --- /dev/null +++ b/fs_sesmon/FS-SessionClient/MANIFEST.SKIP @@ -0,0 +1 @@ +CVS/ diff --git a/fs_sesmon/FS-SessionClient/Makefile.PL b/fs_sesmon/FS-SessionClient/Makefile.PL new file mode 100644 index 000000000..137b6b8bd --- /dev/null +++ b/fs_sesmon/FS-SessionClient/Makefile.PL @@ -0,0 +1,10 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'NAME' => 'FS::SessionClient', + 'VERSION_FROM' => 'SessionClient.pm', # finds $VERSION + 'EXE_FILES' => [ qw(fs_sessiond bin/freeside-login bin/freeside-logout) ], + 'INSTALLSCRIPT' => '/usr/local/sbin', + 'PERM_RWX' => '750', +); diff --git a/fs_sesmon/FS-SessionClient/SessionClient.pm b/fs_sesmon/FS-SessionClient/SessionClient.pm new file mode 100644 index 000000000..0d3f86b4d --- /dev/null +++ b/fs_sesmon/FS-SessionClient/SessionClient.pm @@ -0,0 +1,118 @@ +package FS::SessionClient; + +use strict; +use vars qw($AUTOLOAD $VERSION @ISA @EXPORT_OK $fs_sessiond_socket); +use Exporter; +use Socket; +use FileHandle; +use IO::Handle; + +$VERSION = '0.01'; + +@ISA = qw( Exporter ); +@EXPORT_OK = qw( login logout portnum ); + +$fs_sessiond_socket = "/usr/local/freeside/fs_sessiond_socket"; + +$ENV{'PATH'} ='/usr/bin:/bin'; +$ENV{'SHELL'} = '/bin/sh'; +$ENV{'IFS'} = " \t\n"; +$ENV{'CDPATH'} = ''; +$ENV{'ENV'} = ''; +$ENV{'BASH_ENV'} = ''; + +my $freeside_uid = scalar(getpwnam('freeside')); +die "not running as the freeside user\n" if $> != $freeside_uid; + +=head1 NAME + +FS::SessionClient - Freeside session client API + +=head1 SYNOPSIS + + use FS::SessionClient qw( login portnum logout ); + + $error = login ( { + 'username' => $username, + 'password' => $password, + 'login' => $timestamp, + 'portnum' => $portnum, + } ); + + $portnum = portnum( { 'ip' => $ip } ) or die "unknown ip!" + $portnum = portnum( { 'nasnum' => $nasnum, 'nasport' => $nasport } ) + or die "unknown nasnum/nasport"; + + $error = logout ( { + 'username' => $username, + 'password' => $password, + 'logout' => $timestamp, + 'portnum' => $portnum, + } ); + +=head1 DESCRIPTION + +This modules provides an API for a remote session application. + +It needs to be run as the freeside user. Because of this, the program which +calls these subroutines should be written very carefully. + +=head1 SUBROUTINES + +=over 4 + +=item login HASHREF + +HASHREF should have the following keys: username, password, login and portnum. +login is a UNIX timestamp; if not specified, will default to the current time. +Starts a new session for the specified user and portnum. The password is +optional, but must be correct if specified. + +Returns a scalar error message, or the empty string for success. + +=item portnum + +HASHREF should contain a single key: ip, or the two keys: nasnum and nasport. +Returns a portnum suitable for the login and logout subroutines, or false +on error. + +=item logout HASHREF + +HASHREF should have the following keys: usrename, password, logout and portnum. +logout is a UNIX timestamp; if not specified, will default to the current time. +Starts a new session for the specified user and portnum. The password is +optional, but must be correct if specified. + +Returns a scalar error message, or the empty string for success. + +=cut + +sub AUTOLOAD { + my $hashref = shift; + my $method = $AUTOLOAD; + $method =~ s/^.*:://; + socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; + connect(SOCK, sockaddr_un($fs_sessiond_socket)) or die "connect: $!"; + print SOCK "$method\n"; + + print SOCK join("\n", %{$hashref}, 'END' ), "\n"; + SOCK->flush; + + chomp( my $r = ); + $r; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L + +=cut + +1; + + + diff --git a/fs_sesmon/FS-SessionClient/bin/freeside-login b/fs_sesmon/FS-SessionClient/bin/freeside-login new file mode 100644 index 000000000..a6d475169 --- /dev/null +++ b/fs_sesmon/FS-SessionClient/bin/freeside-login @@ -0,0 +1,36 @@ +#!/usr/bin/perl -Tw + +#false-laziness hack w freeside-logout + +use strict; +use FS::SessionClient qw( login portnum ); + +my $username = shift; + +my $portnum; +if ( scalar(@ARGV) == 1 ) { + my $arg = shift; + if ( $arg =~ /^(\d+)$/ ) { + $portnum = $1; + } elsif ( $arg =~ /^([\d\.]+)$/ ) { + $portnum = portnum( { 'ip' => $1 } ) or die "unknown ip!" + } else { + &usage; + } +} elsif ( scalar(@ARGV) == 2 ) { + $portnum = portnum( { 'nasnum' => shift, 'nasport' => shift } ) + or die "unknown nasnum/nasport"; +} else { + &usage; +} + +my $error = login ( { + 'username' => $username, + 'portnum' => $portnum, +} ); + +warn $error if $error; + +sub usage { + die "Usage:\n\n freeside-login username ( portnum | ip | nasnum nasport )"; +} diff --git a/fs_sesmon/FS-SessionClient/bin/freeside-logout b/fs_sesmon/FS-SessionClient/bin/freeside-logout new file mode 100644 index 000000000..9b4ecfe23 --- /dev/null +++ b/fs_sesmon/FS-SessionClient/bin/freeside-logout @@ -0,0 +1,36 @@ +#!/usr/bin/perl -Tw + +#false-laziness hack w freeside-login + +use strict; +use FS::SessionClient qw( logout portnum ); + +my $username = shift; + +my $portnum; +if ( scalar(@ARGV) == 1 ) { + my $arg = shift; + if ( $arg =~ /^(\d+)$/ ) { + $portnum = $1; + } elsif ( $arg =~ /^([\d\.]+)$/ ) { + $portnum = portnum( { 'ip' => $1 } ) or die "unknown ip!" + } else { + &usage; + } +} elsif ( scalar(@ARGV) == 2 ) { + $portnum = portnum( { 'nasnum' => shift, 'nasport' => shift } ) + or die "unknown nasnum/nasport"; +} else { + &usage; +} + +my $error = logout ( { + 'username' => $username, + 'portnum' => $portnum, +} ); + +warn $error if $error; + +sub usage { + die "Usage:\n\n freeside-logout username ( portnum | ip | nasnum nasport )"; +} diff --git a/fs_sesmon/FS-SessionClient/cgi/login.cgi b/fs_sesmon/FS-SessionClient/cgi/login.cgi new file mode 100644 index 000000000..0307c5a3d --- /dev/null +++ b/fs_sesmon/FS-SessionClient/cgi/login.cgi @@ -0,0 +1,108 @@ +#!/usr/bin/perl -Tw + +#false-laziness hack w logout.cgi + +use strict; +use vars qw( $cgi $username $password $error $ip $portnum ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use FS::SessionClient qw( login portnum ); + +$cgi = new CGI; + +if ( defined $cgi->param('magic') ) { + $cgi->param('username') =~ /^\s*(\w{1,255})\s*$/ or do { + $error = "Illegal username"; + &print_form; + exit; + }; + $username = $1; + $cgi->param('password') =~ /^([^\n]{0,255})$/ or die "guru meditation #420"; + $password = $1; + #$ip = $cgi->remote_host; + $ip = $ENV{REMOTE_ADDR}; + $ip =~ /^([\d\.]+)$/ or die "illegal ip: $ip"; + $ip = $1; + $portnum = portnum( { 'ip' => $1 } ) or do { + $error = "You appear to be coming from an unknown IP address. Verify ". + "that your computer is set to obtain an IP address automatically ". + "via DHCP."; + &print_form; + exit; + }; + + ( $error = login ( { + 'username' => $username, + 'portnum' => $portnum, + 'password' => $password, + } ) ) + ? &print_form() + : &print_okay(); + +} else { + $username = ''; + $password = ''; + $error = ''; + &print_form; +} + +sub print_form { + my $self_url = $cgi->self_url; + + print $cgi->header( '-expires' => 'now' ), <login + +END + +print qq!Error: $error! if $error; + +print < + + + + + + + + + + + + + + + + +
    + Welcome +
    + Username + + +
    + Password + + +
    + +
    + + + +END + +} + +sub print_okay { + print $cgi->header( '-expires' => 'now' ), <login sucessful +login successful, etc. + + +END +} + +sub usage { + die "Usage:\n\n freeside-login username ( portnum | ip | nasnum nasport )"; +} diff --git a/fs_sesmon/FS-SessionClient/cgi/logout.cgi b/fs_sesmon/FS-SessionClient/cgi/logout.cgi new file mode 100644 index 000000000..95cef98d1 --- /dev/null +++ b/fs_sesmon/FS-SessionClient/cgi/logout.cgi @@ -0,0 +1,83 @@ +#!/usr/bin/perl -Tw + +#false-laziness hack w login.cgi + +use strict; +use vars qw( $cgi $username $password $error $ip $portnum ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use FS::SessionClient qw( logout portnum ); + +$cgi = new CGI; + +if ( defined $cgi->param('magic') ) { + $cgi->param('username') =~ /^\s*(\w{1,255})\s*$/ or do { + $error = "Illegal username"; + &print_form; + exit; + }; + $username = $1; + $cgi->param('password') =~ /^([^\n]{0,255})$/ or die "guru meditation #420"; + $password = $1; + #$ip = $cgi->remote_host; + $ip = $ENV{REMOTE_ADDR}; + $ip =~ /^([\d\.]+)$/ or die "illegal ip: $ip"; + $ip = $1; + $portnum = portnum( { 'ip' => $1 } ) or do { + $error = "You appear to be coming from an unknown IP address. Verify ". + "that your computer is set to obtain an IP address automatically ". + "via DHCP."; + &print_form; + exit; + }; + + ( $error = logout ( { + 'username' => $username, + 'portnum' => $portnum, + 'password' => $password, + } ) ) + ? &print_form() + : &print_okay(); + +} else { + $username = ''; + $password = ''; + $error = ''; + &print_form; +} + +sub print_form { + my $self_url = $cgi->self_url; + + print $cgi->header( '-expires' => 'now' ), <logout + +END + +print qq!Error: $error! if $error; + +print < + +Username
    +Password
    + + + + +END + +} + +sub print_okay { + print $cgi->header( '-expires' => 'now' ), <logout sucessful +logout successful, etc. + + +END +} + +sub usage { + die "Usage:\n\n freeside-logout username ( portnum | ip | nasnum nasport )"; +} diff --git a/fs_sesmon/FS-SessionClient/fs_sessiond b/fs_sesmon/FS-SessionClient/fs_sessiond new file mode 100644 index 000000000..bfdb20a1d --- /dev/null +++ b/fs_sesmon/FS-SessionClient/fs_sessiond @@ -0,0 +1,65 @@ +#!/usr/bin/perl -Tw +# +# fs_sessiond +# +# This is run REMOTELY over ssh by fs_session_server +# + +use strict; +use Socket; + +use vars qw( $Debug ); + +$Debug = 1; + +my $fs_sessiond_socket = "/usr/local/freeside/fs_sessiond_socket"; + +$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'} = ''; + +$|=1; + +my $me = "[fs_sessiond]"; + +warn "$me starting\n" if $Debug; +#nothing to read from server + +warn "$me creating $fs_sessiond_socket\n" if $Debug; +my $uaddr = sockaddr_un($fs_sessiond_socket); +my $proto = getprotobyname('tcp'); +socket(Server,PF_UNIX,SOCK_STREAM,0) or die "socket: $!"; +unlink($fs_sessiond_socket); +bind(Server, $uaddr) or die "bind: $!"; +listen(Server,SOMAXCONN) or die "listen: $!"; + +warn "$me entering main loop\n" if $Debug; +my $paddr; +for ( ; $paddr = accept(Client,Server); close Client) { + + chomp( my $command = ); + + if ( $command eq 'login' || $command eq 'logout' || $command eq 'portnum' ) { + warn "$me reading data from local client\n" if $Debug; + my @data; + my $dos = 0; + push @data, scalar() until $dos++ == 99 || $data[$#data] eq "END\n"; + if ( $dos == 99 ) { + warn "$me WARNING: DoS attempt!" + } else { + warn "$me sending data to remote server\n" if $Debug; + print "$command\n", @data; + warn "$me reading result from remote server\n" if $Debug; + my $error = ; + warn "$me sending error to local client\n" if $Debug; + print Client $error; + } + } else { + warn "$me WARNING: unexpected command from client: $command"; + } + +} + diff --git a/fs_sesmon/FS-SessionClient/test.pl b/fs_sesmon/FS-SessionClient/test.pl new file mode 100644 index 000000000..4b9ae17e0 --- /dev/null +++ b/fs_sesmon/FS-SessionClient/test.pl @@ -0,0 +1,21 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. + +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..1\n"; } +END {print "not ok 1\n" unless $loaded;} +#use FS::SessionClient; +#sigh, "not running as the freeside user" +$loaded = 1; +print "ok 1\n"; + +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + diff --git a/fs_sesmon/fs_session_server b/fs_sesmon/fs_session_server new file mode 100644 index 000000000..00229f8dc --- /dev/null +++ b/fs_sesmon/fs_session_server @@ -0,0 +1,140 @@ +#!/usr/bin/perl -Tw +# +# fs_session_server +# + +use strict; +use vars qw( $opt $Debug ); +use IO::Handle; +use Net::SSH qw(sshopen2); +use FS::UID qw(adminsuidsetup dbh); +use FS::Record qw( qsearchs ); #qsearch ); +#use FS::cust_main_county; +#use FS::cust_main; +use FS::session; +use FS::port; +use FS::svc_acct; + +#require "configfile"; +$Debug = 1; + +my $user = shift or die &usage; +&adminsuidsetup( $user ); + +my $machine = shift or die &usage; + +my $fs_sessiond = "/usr/local/sbin/fs_sessiond"; + +my $me = "[fs_session_server]"; + +while (1) { + my($reader, $writer) = (new IO::Handle, new IO::Handle); + $writer->autoflush(1); + warn "$me Connecting to $machine\n" if $Debug; + sshopen2($machine,$reader,$writer,$fs_sessiond); + + warn "$me Entering main loop\n" if $Debug; + while (1) { + warn "$me Reading (waiting for) data\n" if $Debug; + my $command = scalar(<$reader>); + chomp $command; + #DoS protection here too, to protect against a compromised client? *sigh* + my %hash; + while ( ( my $key = scalar(<$reader>) ) ne "END\n" ) { + chomp $key; + chomp( $hash{$key} = scalar(<$reader>) ); + } + + if ( $command eq 'login' ) { + my $error = &login(\%hash); + print $writer "$error\n"; + } elsif ( $command eq 'logout' ) { + my $error = &logout(\%hash); + print $writer "$error\n"; + } elsif ( $command eq 'portnum' ) { + my $port; + if ( exists $hash{'ip'} ) { + $hash{'ip'} =~ /^([\d\.]+)$/ or $1='nomatch'; + $port = qsearchs('port', { 'ip' => $1 } ); + } else { + $hash{'nasnum'} =~ /^(\d+)$/ and my $nasnum = $1; + $hash{'nasport'} =~ /^(\d+)$/ and my $nasport = $1; + $port = qsearchs('port', { 'nasnum'=>$nasnum, 'nasport'=>$nasport } ); + } + print $writer ( $port ? $port->portnum : '' ), "\n"; + } else { + warn "$me WARNING: unrecognized command: $command"; + } + } + #won't ever reach without code above to throw out of loop, but... + close $writer; + close $reader; + warn "connection to $machine lost!\n"; + sleep 5; + warn "reconnecting...\n"; +} + +sub login { + my $href = shift; + $href->{'username'} =~ /^([a-z0-9_\-\.]+)$/ or return "Illegal username"; + my $username = $1; + my $svc_acct = qsearchs('svc_acct', { 'username' => $username } ) + or return "Unknown user"; + return "Incorrect password" + if exists($href->{'password'}) + && $href->{'password'} ne $svc_acct->_password; + return "Time limit exceeded" unless $svc_acct->seconds; + my $session = new FS::session { + 'portnum' => $href->{'portnum'}, + 'svcnum' => $svc_acct->svcnum, + 'login' => $href->{'login'}, + }; + $session->insert; +} + +sub logout { + my $href = shift; + $href->{'username'} =~ /^([a-z0-9_\-\.]+)$/ or return "Illegal username"; + my $username = $1; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + my $svc_acct = + qsearchs('svc_acct', { 'username' => $username }, '', 'FOR UPDATE' ) + or return "Unknown user"; + return "Incorrect password" + if exists($href->{'password'}) + && $href->{'password'} ne $svc_acct->_password; + my $session = qsearchs( 'session', { + 'portnum' => $href->{'portnum'}, + 'svcnum' => $svc_acct->svcnum, + 'logout' => '', + }, + '', 'FOR UPDATE' + ); + unless ( $session ) { + $dbh->rollback; + return "No currently open sessions found for that user/port!"; + } + my $nsession = new FS::session ( { $session->hash } ); + warn "$nsession replacing $session"; + my $error = $nsession->replace($session); + if ( $error ) { + $dbh->rollback; + return "can't logout: $error"; + } + my $time = $nsession->logout - $nsession->login; + my $new_svc_acct = new FS::svc_acct ( { $svc_acct->hash } ); + my $seconds = $new_svc_acct->seconds; + $seconds -= $time; + $seconds = 0 if $seconds < 0; + $new_svc_acct->seconds( $seconds ); + $error = $new_svc_acct->replace( $svc_acct ); + warn "can't debit time: $error\n"; #don't want to rollback, though + $dbh->commit or die $dbh->errstr; + '' +} + +sub usage { + die "Usage:\n\n fs_session_server user machine\n"; +} + diff --git a/htetc/freeside-base1.99.conf b/htetc/freeside-base1.99.conf new file mode 100644 index 000000000..c1c187c8d --- /dev/null +++ b/htetc/freeside-base1.99.conf @@ -0,0 +1,21 @@ +PerlModule Apache::compat + +#PerlModule Apache::DBI + +PerlModule HTML::Mason +PerlSetVar MasonArgsMethod CGI +PerlModule HTML::Mason::ApacheHandler + +PerlRequire "%%%MASON_HANDLER%%%" + + +AuthName Freeside +AuthType Basic +AuthUserFile /usr/local/etc/freeside/htpasswd +require valid-user + +SetHandler perl-script +PerlHandler HTML::Mason + + + diff --git a/htetc/freeside-base1.conf b/htetc/freeside-base1.conf new file mode 100644 index 000000000..3f6bd0ee3 --- /dev/null +++ b/htetc/freeside-base1.conf @@ -0,0 +1,18 @@ +#PerlModule Apache::DBI + +PerlModule HTML::Mason + + +AuthName Freeside +AuthType Basic +AuthUserFile /usr/local/etc/freeside/htpasswd +require valid-user + +AddHandler perl-script .cgi .html +PerlHandler HTML::Mason + + +require "%%%MASON_HANDLER%%%"; + + + diff --git a/htetc/freeside-base2.conf b/htetc/freeside-base2.conf new file mode 100644 index 000000000..38f784068 --- /dev/null +++ b/htetc/freeside-base2.conf @@ -0,0 +1,21 @@ +PerlModule Apache2::compat + +#PerlModule Apache::DBI + +PerlModule HTML::Mason +PerlSetVar MasonArgsMethod CGI +PerlModule HTML::Mason::ApacheHandler + +PerlRequire "%%%MASON_HANDLER%%%" + + +AuthName Freeside +AuthType Basic +AuthUserFile /usr/local/etc/freeside/htpasswd +require valid-user + +SetHandler perl-script +PerlHandler HTML::Mason + + + diff --git a/htetc/freeside-rt.conf b/htetc/freeside-rt.conf new file mode 100644 index 000000000..9b5ccf807 --- /dev/null +++ b/htetc/freeside-rt.conf @@ -0,0 +1,36 @@ + + +allow from all +Satisfy any +SetHandler perl-script +PerlHandler HTML::Mason + + + + + +allow from all +Satisfy any +SetHandler perl-script +PerlHandler HTML::Mason + + + + +SetHandler None + + + +SetHandler perl-script +PerlHandler HTML::Mason + + + +SetHandler perl-script +PerlHandler HTML::Mason + + + +SetHandler perl-script +PerlHandler HTML::Mason + diff --git a/htetc/handler.pl b/htetc/handler.pl new file mode 100644 index 000000000..caa266df0 --- /dev/null +++ b/htetc/handler.pl @@ -0,0 +1,390 @@ +#!/usr/bin/perl + +package HTML::Mason; + +use strict; +use vars qw($r); +use HTML::Mason 1.27; #http://www.masonhq.com/?ApacheModPerl2Redirect +use HTML::Mason::Interp; +use HTML::Mason::Compiler::ToObject; + +# Bring in ApacheHandler, necessary for mod_perl integration. +# Uncomment the second line (and comment the first) to use +# Apache::Request instead of CGI.pm to parse arguments. +use HTML::Mason::ApacheHandler; +# use HTML::Mason::ApacheHandler (args_method=>'mod_perl'); + +###use Module::Refresh;### + +# List of modules that you want to use from components (see Admin +# manual for details) +#{ package HTML::Mason::Commands; +# use CGI; +#} + +if ( %%%RT_ENABLED%%% ) { + eval ' + use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" ); + use RT; + use vars qw($Nobody $SystemUser); + RT::LoadConfig(); + '; + die $@ if $@; +} + +# Create Mason objects + +my %interp = ( + request_class => 'HTML::Mason::Request::ApacheHandler', + data_dir => '%%%MASONDATA%%%', + error_mode => 'output', + error_format => 'html', + ignore_warnings_expr => '.', + comp_root => [ + [ 'freeside' => '%%%FREESIDE_DOCUMENT_ROOT%%%' ], + [ 'rt' => '%%%FREESIDE_DOCUMENT_ROOT%%%/rt' ], + ], +); + +my $fs_interp = new HTML::Mason::Interp ( + %interp, + escape_flags => { 'js_string' => sub { + #${$_[0]} =~ s/(['\\\n])/'\\'.($1 eq "\n" ? 'n' : $1)/ge; + ${$_[0]} =~ s/(['\\])/\\$1/g; + ${$_[0]} =~ s/\n/\\n/g; + ${$_[0]} = "'". ${$_[0]}. "'"; + } + }, +); + +my $rt_interp = new HTML::Mason::Interp ( + %interp, + escape_flags => { 'h' => \&RT::Interface::Web::EscapeUTF8 }, + compiler => HTML::Mason::Compiler::ToObject->new( + default_escape_flags => 'h', + allow_globals => [qw(%session)], + ), +); + +my $ah = new HTML::Mason::ApacheHandler ( + interp => $fs_interp, + args_method => 'CGI', #(and FS too) +); + +# Activate the following if running httpd as root (the normal case). +# Resets ownership of all files created by Mason at startup. +# +#chown (Apache->server->uid, Apache->server->gid, $interp->files_written); + +sub handler +{ + ($r) = @_; + + # If you plan to intermix images in the same directory as + # components, activate the following to prevent Mason from + # evaluating image files as components. + # + #return -1 if $r->content_type && $r->content_type !~ m|^text/|i; + + #rar + { package HTML::Mason::Commands; + use strict; + use vars qw( $cgi $p $fsurl); + use vars qw( %session ); + use CGI 2.47 qw(-private_tempfiles); + #use CGI::Carp qw(fatalsToBrowser); + use CGI::Cookie; + use List::Util qw( max min ); + use Data::Dumper; + use Date::Format; + use Date::Parse; + use Time::Local; + use Time::Duration; + use DateTime; + use DateTime::Format::Strptime; + use Lingua::EN::Inflect qw(PL); + use Tie::IxHash; + use URI::Escape; + use HTML::Entities; + use JSON; + 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 Business::CreditCard 0.30; #for mask-aware cardtype() + use NetAddr::IP; + use String::Approx qw(amatch); + use Chart::LinesPoints; + use Chart::Mountain; + use Color::Scheme; + use HTML::Widgets::SelectLayers 0.07; + use Locale::Country; + use FS; + use FS::UID qw(cgisuidsetup dbh getotaker datasrc driver_name); + use FS::Record qw(qsearch qsearchs fields dbdef str2time_sql); + use FS::Conf; + use FS::CGI qw(header menubar popurl rooturl table itable ntable idiot + eidiot small_custview myexit http_header); + use FS::UI::Web qw(svc_url); + use FS::UI::bytecount; + use FS::Msgcat qw(gettext geterror); + use FS::Misc qw( send_email send_fax states_hash counties state_label ); + use FS::Report::Table::Monthly; + use FS::TicketSystem; + + 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 qw(smart_search); + use FS::cust_main_county; + use FS::part_pkg_taxclass; + use FS::cust_pay; + use FS::cust_pkg; + use FS::cust_pkg_reason; + use FS::cust_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::msgcat; + use FS::rate; + use FS::rate_region; + use FS::rate_prefix; + use FS::payment_gateway; + use FS::agent_payment_gateway; + use FS::XMLRPC; + use FS::payby; + use FS::cdr; + use FS::inventory_class; + use FS::inventory_item; + 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::reason_type; + use FS::reason; + use FS::cust_main_note; + + if ( %%%RT_ENABLED%%% ) { + eval ' + 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; + + #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) ) { #profiling redirect + + my $page = + qq!Redirect to $location!. + '

    '.
    +              ( UNIVERSAL::can(dbh, 'sprintProfile')
    +                  ? encode_entities(dbh->sprintProfile())
    +                  : 'DBIx::Profile missing sprintProfile method;'.
    +                    'unpatched or too old?'                        ).
    +            #"\n\n". &sprintAutoProfile().  '
    '. + "\n\n". ''. + ''; + dbh->{'private_profile'} = {}; + return $page; + + } else { #normal redirect + + $m->redirect($location); + ''; + + } + + }; + + unless ( $HTML::Mason::r->filename =~ /\/rt\/.*NoAuth/ ) { #RT + $cgi = new CGI; + &cgisuidsetup($cgi); + #&cgisuidsetup($r); + $p = popurl(2); + $fsurl = rooturl(); + } + + sub include { + use vars qw($m); + $m->scomp(@_); + } + + sub errorpage { + use vars qw($m); + $m->comp('/elements/errorpage.html', @_); + } + + sub redirect { + my( $location ) = @_; + use vars qw($m); + $m->clear_buffer; + #false laziness w/above + if ( defined(@DBIx::Profile::ISA) ) { #profiling redirect + + $m->print( + qq!Redirect to $location!. + '

    '.
    +              ( UNIVERSAL::can(dbh, 'sprintProfile')
    +                  ? encode_entities(dbh->sprintProfile())
    +                  : 'DBIx::Profile missing sprintProfile method;'.
    +                    'unpatched or too old?'                        ).
    +            #"\n\n". &sprintAutoProfile().  '
    '. + "\n\n". ''. + '' + ); + dbh->{'private_profile'} = {}; + + #whew. removing this is all that's needed to fix the annoying + #blank-page-instead-of-profiling-redirect-when-called-from-an-include + #bug triggered by mason 1.32 + #my $rv = $m->abort(200); + + } else { #normal redirect + + $m->redirect($location); + + } + + } + + } # end package HTML::Mason::Commands; + + ###Module::Refresh->refresh;### + + $r->content_type('text/html'); + #eorar + + my $headers = $r->headers_out; + $headers->{'Cache-control'} = 'no-cache'; + #$r->no_cache(1); + $headers->{'Expires'} = '0'; + +# $r->send_http_header; + + if ( $r->filename =~ /\/rt\// ) { #RT + + $ah->interp($rt_interp); + + local $SIG{__WARN__}; + local $SIG{__DIE__}; + + RT::Init(); + + # We don't need to handle non-text, non-xml items + return -1 if defined( $r->content_type ) + && $r->content_type !~ m!(^text/|\bxml\b)!io; + + } else { + + $ah->interp($fs_interp); + + } + + my %session; + my $status; + eval { $status = $ah->handle_request($r); }; +#!! +# if ( $@ ) { +# $RT::Logger->crit($@); +# } + warn $@ if $@; + + undef %session; + +#!! +# if ($RT::Handle->TransactionDepth) { +# $RT::Handle->ForceRollback; +# $RT::Logger->crit( +#"Transaction not committed. Usually indicates a software fault. Data loss may have occurred" +# ); +# } + + $status; +} + +1; diff --git a/httemplate/.htaccess b/httemplate/.htaccess new file mode 100755 index 000000000..f8c6b9c0c --- /dev/null +++ b/httemplate/.htaccess @@ -0,0 +1,3 @@ +AuthName Freeside +AuthType Basic +require valid-user diff --git a/httemplate/autohandler b/httemplate/autohandler new file mode 100644 index 000000000..bdea50534 --- /dev/null +++ b/httemplate/autohandler @@ -0,0 +1,35 @@ +% $m->call_next; +<%init> + dbh->{'private_profile'} = {} if UNIVERSAL::can(dbh, 'sprintProfile'); + +<%filter> + +my $profile = ''; +if ( UNIVERSAL::can(dbh, 'sprintProfile') ) { + + if ( lc($r->content_type) eq 'text/html' ) { + + ## barely worth it, just in case someone tries to use profiling on a + ## non-RT install + #eval "use Text::Wrapper;"; + #die $@ if $@; + + my $wrapper = new Text::Wrapper( columns => 80 ); + my $text = dbh->sprintProfile(); + #my $text = $wrapper->wrap( dbh->sprintProfile() ); + $text =~ s/^/ /mg; + + $profile = '
    '.
    +               encode_entities( $text ).
    +               #"\n\n". &sprintAutoProfile(). '
    '; + "\n\n". ''; + } + + dbh->{'private_profile'} = {}; +} + +s/(<\/BODY>[\s\n]*<\/HTML>[\s\n]*)$/$profile$1/i; + +<%cleanup> + dbh->commit(); + diff --git a/httemplate/browse/access_group.html b/httemplate/browse/access_group.html new file mode 100644 index 000000000..736ab9c62 --- /dev/null +++ b/httemplate/browse/access_group.html @@ -0,0 +1,108 @@ +<% include( 'elements/browse.html', + 'title' => 'Internal Access Groups', + 'menubar' => [ 'Internal users' => $p.'browse/access_user.html', ], + 'html_init' => $html_init, + 'name' => 'internal access groups', + 'query' => { 'table' => 'access_group', + 'hashref' => {}, + 'extra_sql' => 'ORDER BY groupname', #?? + }, + 'count_query' => $count_query, + 'header' => [ '#', + 'Group name', + 'Agents', + 'Rights', + ], + 'fields' => [ 'groupnum', + 'groupname', + $agents_sub, + $rights_sub, + ], + 'links' => [ $link, + $link, + '', + '', + ], + ) +%> +<%once> + +my $html_init = + "Internal access groups control access to the back-office interface.

    ". + qq!Add an internal access group

    !; + +#false laziness w/access_user.html & agent_type.cgi +my $agents_sub = sub { + my $access_group = shift; + + [ map { + my $access_groupagent = $_; + my $agent = $access_groupagent->agent; + [ + { + 'data' => $agent->agent, + 'align' => 'left', + 'link' => $p. 'edit/agent.cgi?'. $agent->agentnum, + }, + ]; + } + grep { $_->agent } #? + $access_group->access_groupagent, + + ]; + +}; + +tie my %rights, 'Tie::IxHash', FS::AccessRight->rights_info; + +my $rights_sub = sub { + my $access_group = shift; + + #[ map { my $access_right = $_; + # [ + # { + # 'data' => $access_right->rightname, + # 'align' => 'left', + # }, + # ]; + # } + # $access_group->access_rights, + #]; + + #some false laziness w/edit/access_group.html + my $columns = 3; + my $count = 0; + + #include('/elements/table-grid.html', bgcolor=>'#cccccc' ). + ''. + ''. join( '', map { + + ''. + ( ++$count % $columns ? '' : '') + + } keys %rights ). '
    '. + ''. + '
    '. $_. '
    '. + + join('
    ', grep { warn "$access_group->access_right($_): ". + $access_group->access_right($_). "\n"; + $access_group->access_right($_); } + map { ref($_) ? $_->{'rightname'} : $_; } + @{ $rights{$_} } + ). + + '
    '; + +}; + +my $count_query = 'SELECT COUNT(*) FROM access_group'; + +my $link = [ $p.'edit/access_group.html?', 'groupnum' ]; + + +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); + + diff --git a/httemplate/browse/access_user.html b/httemplate/browse/access_user.html new file mode 100644 index 000000000..2aa752b73 --- /dev/null +++ b/httemplate/browse/access_user.html @@ -0,0 +1,61 @@ +<% include( 'elements/browse.html', + 'title' => 'Internal Users', + 'menubar' => [ 'Internal access groups' => $p.'browse/access_group.html', ], + 'html_init' => $html_init, + 'name' => 'internal users', + 'disableable' => 1, + 'disabled_statuspos' => 2, + 'query' => { 'table' => 'access_user', + 'hashref' => {}, + 'extra_sql' => 'ORDER BY last, first' + }, + 'count_query' => $count_query, + 'header' => \@header, + 'fields' => \@fields, + 'links' => \@links, + 'align' => $align, + ) +%> +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); + +my $html_init = + "Internal users have access to the back-office interface. Typically, this is your employees and contractors. In a VISP setup, you can also add accounts for your reseller's employees.

    It is highly recommended to add a separate account for each person rather than using role accounts.

    ". + qq!Add an internal user

    !; + +#false laziness w/access_group.html & agent_type.cgi +my $groups_sub = sub { + my $access_user = shift; + + [ map { + my $access_usergroup = $_; + my $access_group = $access_usergroup->access_group; + [ + { + 'data' => $access_group->groupname, + 'align' => 'left', + 'link' => + $p. 'edit/access_group.html?'. $access_usergroup->groupnum, + }, + ]; + } + grep { $_->access_group # and ! $_->access_group->disabled + } + $access_user->access_usergroup, + + ]; + +}; + +my $count_query = 'SELECT COUNT(*) FROM access_user'; + +my $link = [ $p.'edit/access_user.html?', 'usernum' ]; + +my @header = ( '#', 'Username', 'Full name', 'Groups' ); +my @fields = ( 'usernum', 'username', 'name', $groups_sub ); +my $align = 'rlll'; +my @links = ( $link, $link, $link, '' ); + + diff --git a/httemplate/browse/addr_block.cgi b/httemplate/browse/addr_block.cgi new file mode 100644 index 000000000..eac7cf7b6 --- /dev/null +++ b/httemplate/browse/addr_block.cgi @@ -0,0 +1,80 @@ +<% include('/elements/header.html', 'Address Blocks') %> + +<% include('/elements/error.html') %> + +<%table()%> +% foreach $block (sort {$a->NetAddr cmp $b->NetAddr} @addr_block) { + + + <%$block->NetAddr%> +% if (my $router = $block->router) { +% if (scalar($block->svc_broadband) == 0) { + + + <%$router->routername%> + + +
    + + +
    + +% } else { + + + <%$router->routername%> + +% } +% } else { + + +
    + + + +
    + + +
    + + +
    + + +% } +% } + +
    + +
    + Gateway/Netmask + + / + + + + +
    + + + +<% include('/elements/footer.html') %> + +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); + +my @addr_block = qsearch('addr_block', {}); +my @router = qsearch('router', {}); +my $block; +my $p2 = popurl(2); +my $path = $p2 . "edit/process/addr_block"; + + diff --git a/httemplate/browse/agent.cgi b/httemplate/browse/agent.cgi new file mode 100755 index 000000000..234bfa74a --- /dev/null +++ b/httemplate/browse/agent.cgi @@ -0,0 +1,401 @@ +<% include("/elements/header.html",'Agent Listing', menubar( + 'Agent Types' => $p. 'browse/agent_type.cgi', +# 'Add new agent' => '../edit/agent.cgi' +)) %> +Agents are resellers of your service. Agents may be limited to a subset of your +full offerings (via their type).

    +Add a new agent

    +% if ( dbdef->table('agent')->column('disabled') ) { + + <% $cgi->param('showdisabled') + ? do { $cgi->param('showdisabled', 0); + '( hide disabled agents )'; } + : do { $cgi->param('showdisabled', 1); + '( show disabled agents )'; } + %> +% } + + +<% include('/elements/table-grid.html') %> +% my $bgcolor1 = '#eeeeee'; +% my $bgcolor2 = '#ffffff'; +% my $bgcolor = ''; +% + + + + param('showdisabled') || !dbdef->table('agent')->column('disabled') ) ? 2 : 3 %>>Agent + Type + Invoice
    Template
    + Customers + Customer
    packages
    + Reports + Registration
    codes
    + Prepaid cards +% if ( $conf->config('ticket_system') ) { + + Ticketing +% } + + Payment Gateway Overrides + Configuration Overrides + +% +%# Agent # +%# Agent +% +%foreach my $agent ( sort { +% #$a->getfield('agentnum') <=> $b->getfield('agentnum') +% $a->getfield('agent') cmp $b->getfield('agent') +%} qsearch('agent', \%search ) ) { +% +% my $cust_main_link = $p. 'search/cust_main.cgi?agentnum_on=1&'. +% 'agentnum='. $agent->agentnum; +% +% my $cust_pkg_link = $p. 'search/cust_pkg.cgi?agentnum='. $agent->agentnum; +% +% if ( $bgcolor eq $bgcolor1 ) { +% $bgcolor = $bgcolor2; +% } else { +% $bgcolor = $bgcolor1; +% } +% +% + + + + + + <% $agent->agentnum %> + + +% if ( dbdef->table('agent')->column('disabled') +% && !$cgi->param('showdisabled') ) { + + <% $agent->disabled ? 'DISABLED' : '' %> + +% } + + + <% $agent->agent %> + + + + <% $agent->agent_type->atype %> + + + + <% $agent->invoice_template || '(Default)' %> + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    + + <% my $num_prospect = $agent->num_prospect_cust_main %>  + + +% if ( $num_prospect ) { + + +% } +prospects +% if ($num_prospect ) { + +% } + + +
    + + <% my $num_inactive = $agent->num_inactive_cust_main %>  + + +% if ( $num_inactive ) { + + +% } +inactive +% if ( $num_inactive ) { + +% } + +
    + + <% my $num_active = $agent->num_active_cust_main %>  + + +% if ( $num_active ) { + + +% } +active +% if ( $num_active ) { + +% } + +
    + + <% my $num_susp = $agent->num_susp_cust_main %>  + + +% if ( $num_susp ) { + + +% } +suspended +% if ( $num_susp ) { + +% } + +
    + + <% my $num_cancel = $agent->num_cancel_cust_main %>  + + +% if ( $num_cancel ) { + + +% } +cancelled +% if ( $num_cancel ) { + +% } + +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    + + <% my $num_inactive_pkg = $agent->num_inactive_cust_pkg %>  + + +% if ( $num_inactive_pkg ) { + + +% } +inactive +% if ( $num_inactive_pkg ) { + +% } + +
    + + <% my $num_active_pkg = $agent->num_active_cust_pkg %>  + + +% if ( $num_active_pkg ) { + + +% } +active +% if ( $num_active_pkg ) { + +% } + +
    + + <% my $num_susp_pkg = $agent->num_susp_cust_pkg %>  + + + +% if ( $num_susp_pkg ) { + + +% } +suspended +% if ( $num_susp_pkg ) { + +% } + +
    + + <% my $num_cancel_pkg = $agent->num_cancel_cust_pkg %>  + + +% if ( $num_cancel_pkg ) { + + +% } +cancelled +% if ( $num_cancel_pkg ) { + +% } + +
    + + + + Package Churn +
    Payments +
    Credits +
    A/R Aging + + + + + + <% my $num_reg_code = $agent->num_reg_code %> +% if ( $num_reg_code ) { + + +% } +Unused +% if ( $num_reg_code ) { + +% } + +
    Generate codes + + + + <% my $num_prepay_credit = $agent->num_prepay_credit %> +% if ( $num_prepay_credit ) { + + +% } +Unused +% if ( $num_prepay_credit ) { + +% } + +
    Generate cards + +% if ( $conf->config('ticket_system') ) { + + + +% if ( $agent->ticketing_queueid ) { + + Queue: <% $agent->ticketing_queueid %>: <% $agent->ticketing_queue %>
    +% } + + +% } + + + + +% foreach my $override ( +% # sort { } want taxclass-full stuff first? and default cards (empty cardtype) +% qsearch('agent_payment_gateway', { 'agentnum' => $agent->agentnum } ) +% ) { +% + + + + +% } + + + + +
    + <% $override->cardtype || 'Default' %> to <% $override->payment_gateway->gateway_module %> (<% $override->payment_gateway->gateway_username %>) + <% $override->taxclass + ? ' for '. $override->taxclass. ' only' + : '' + %> + (delete) +
    (add override)
    + + + + +% foreach my $override ( +% qsearch('conf', { 'agentnum' => $agent->agentnum } ) +% ) { +% + + + + +% } + + + + +
    + <% $override->name %> + (delete) +
    (add override)
    + + + +% } + + + + + +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); + +my %search; +if ( $cgi->param('showdisabled') + || !dbdef->table('agent')->column('disabled') ) { + %search = (); +} else { + %search = ( 'disabled' => '' ); +} + +my $conf = new FS::Conf; + + diff --git a/httemplate/browse/agent_type.cgi b/httemplate/browse/agent_type.cgi new file mode 100755 index 000000000..d64ff186a --- /dev/null +++ b/httemplate/browse/agent_type.cgi @@ -0,0 +1,61 @@ +<% include( 'elements/browse.html', + 'title' => 'Agent Types', + 'menubar' => [ 'Agents' =>"${p}browse/agent.cgi", ], + 'html_init' => $html_init, + 'name' => 'agent types', + 'query' => { 'table' => 'agent_type', + 'hashref' => {}, + 'extra_sql' => 'ORDER BY typenum', # 'ORDER BY atype', + }, + 'count_query' => $count_query, + 'header' => [ '#', + 'Agent Type', + 'Packages', + ], + 'fields' => [ 'typenum', + 'atype', + $packages_sub, + ], + 'links' => [ $link, + $link, + '', + ], + ) +%> +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); + +my $html_init = +'Agent types define groups of packages that you can then assign to'. +' particular agents.

    '. +qq!Add a new agent type

    !; + +my $count_query = 'SELECT COUNT(*) FROM agent_type'; + +#false laziness w/access_user.html +my $packages_sub = sub { +my $agent_type = shift; + +[ map { + my $type_pkgs = $_; + #my $part_pkg = $type_pkgs->part_pkg; + [ + { + #'data' => $part_pkg->pkg. ' - '. $part_pkg->comment, + 'data' => $type_pkgs->pkg. ' - '. $type_pkgs->comment, + 'align' => 'left', + 'link' => $p. 'edit/part_pkg.cgi?'. $type_pkgs->pkgpart, + }, + ]; + } + + $agent_type->type_pkgs_enabled +]; + +}; + +my $link = [ $p.'edit/agent_type.cgi?', 'typenum' ]; + + diff --git a/httemplate/browse/cust_main_county.cgi b/httemplate/browse/cust_main_county.cgi new file mode 100755 index 000000000..12bdeb333 --- /dev/null +++ b/httemplate/browse/cust_main_county.cgi @@ -0,0 +1,288 @@ +<% include( 'elements/browse.html', + 'title' => "Tax Rates $title", + 'name_singular' => 'tax rate', + 'menubar' => \@menubar, + 'html_init' => $html_init, + 'html_posttotal' => $html_posttotal, + 'query' => { + 'table' => 'cust_main_county', + 'hashref' => $hashref, + 'order_by' => + 'ORDER BY country, state, county, taxclass', + }, + 'count_query' => $count_query, + 'header' => \@header, + 'header2' => \@header2, + 'fields' => \@fields, + 'align' => $align, + 'color' => \@color, + 'cell_style' => \@cell_style, + 'links' => \@links, + 'link_onclicks' => \@link_onclicks, + ) +%> +% +% # collapse state +% # % } +% +<%once> + +my $conf = new FS::Conf; +my $money_char = $conf->config('money_char') || '$'; + +my @manual_countries = ( 'US', 'CA', 'AU', 'NZ', 'GB' ); #some manual ordering +my @all_countries = ( @manual_countries, + grep { my $c = $_; ! grep { $c eq $_ } @manual_countries } + map { $_->country } + qsearch({ + 'select' => 'country', + 'table' => 'cust_main_county', + 'hashref' => {}, + 'extra_sql' => 'GROUP BY country', + }) + ); + +my $exempt_sub = sub { + my $cust_main_county = shift; + + my @exempt = (); + push @exempt, + sprintf("$money_char%.2f per month", $cust_main_county->exempt_amount ) + if $cust_main_county->exempt_amount > 0; + + push @exempt, 'Setup fee' + if $cust_main_county->setuptax =~ /^Y$/i; + + push @exempt, 'Recurring fee' + if $cust_main_county->recurtax =~ /^Y$/i; + + [ map [ {'data'=>$_} ], @exempt ]; +}; + +my $oldrow; +my $cell_style; +my $cell_style_sub = sub { + my $row = shift; + if ( $oldrow ne $row ) { + if ( $oldrow ) { + if ( $oldrow->country ne $row->country ) { + $cell_style = 'border-top:1px solid #000000'; + } elsif ( $oldrow->state ne $row->state ) { + $cell_style = 'border-top:1px solid #cccccc'; #default? + } elsif ( $oldrow->state eq $row->state ) { + #$cell_style = 'border-top:dashed 1px dark gray'; + $cell_style = 'border-top:1px dashed #cccccc'; + } + } + $oldrow = $row; + } + return $cell_style; +}; + +#my $edit_link = [ "${p}edit/cust_main_county.html", 'taxnum' ]; +my $edit_link = [ 'javascript:void(0);', sub { ''; } ]; + +my $edit_onclick = sub { + my $row = shift; + my $taxnum = $row->taxnum; + my $color = '#333399'; + qq!overlib( OLiframeContent('${p}edit/cust_main_county.html?$taxnum', 540, 420, 'edit_cust_main_county_popup' ), CAPTION, 'Edit tax rate', STICKY, AUTOSTATUSCAP, MIDX, 0, MIDY, 0, DRAGGABLE, CLOSECLICK, BGCOLOR, '$color', CGCOLOR, '$color' ); return false;!; +}; + +sub expand_link { + my( $row, $desc ) = @_; + my $taxnum = $row->taxnum; + my $url = "${p}edit/cust_main_county-expand.cgi?$taxnum"; + my $color = '#333399'; + + qq!!; +} + +sub separate_taxclasses_link { + my( $row ) = @_; + my $taxnum = $row->taxnum; + my $url = "${p}edit/process/cust_main_county-expand.cgi?taxclass=1;taxnum=$taxnum"; + + qq!!; +} + + +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); + +#my $conf = new FS::Conf; +#my $money_char = $conf->config('money_char') || '$'; +my $enable_taxclasses = $conf->exists('enable_taxclasses'); + +my @menubar; + +my $html_init = + "Click on add states to specify a country's tax rates by state or province. +
    Click on add counties to specify a state's tax rates by county."; +$html_init .= "
    Click on separate taxclasses to specify taxes per taxclass." + if $enable_taxclasses; +$html_init .= '

    '; + +$html_init .= qq( + + + + +); + +my $title = ''; + +my $country = ''; +if ( $cgi->param('country') =~ /^(\w\w)$/ ) { + $country = $1; + $title = $country; +} +$cgi->delete('country'); + +my $state = ''; +if ( $cgi->param('state') =~ /^([\w \-\'\[\]]+)$/ ) { + $state = $1; + $title = "$state, $title"; +} +$cgi->delete('state'); + +my $county = ''; +if ( $cgi->param('county') =~ /^([\w \-\'\[\]]+)$/ ) { + $county = $1; + $title = "$county county, $title"; +} +$cgi->delete('county'); + +$title = " for $title" if $title; + +my $taxclass = ''; +if ( $cgi->param('taxclass') =~ /^([\w \-]+)$/ ) { + $taxclass = $1; + $title .= " for $taxclass tax class"; +} +$cgi->delete('taxclass'); + +if ( $country || $taxclass ) { + push @menubar, 'View all tax rates' => $p.'browse/cust_main_county.cgi'; +} + +$cgi->param('dummy', 1); + +my $country_filter_change = + "window.location = '". + $cgi->self_url. ";country=' + this.options[this.selectedIndex].value;"; + +#restore this so pagination works +$cgi->param('country', $country) if $country; +$cgi->param('state', $state ) if $state; +$cgi->param('county', $county ) if $county; +$cgi->param('taxclass', $county ) if $taxclass; + +my $html_posttotal = + '(show country: '. + qq()'; + +my $hashref = {}; +my $count_query = 'SELECT COUNT(*) FROM cust_main_county'; +if ( $country ) { + $hashref->{'country'} = $country; + $count_query .= ' WHERE country = '. dbh->quote($country); +} +if ( $state ) { + $hashref->{'state'} = $state; + $count_query .= ' AND state = '. dbh->quote($state); +} +if ( $county ) { + $hashref->{'country'} = $country; + $count_query .= ' AND county = '. dbh->quote($county); +} +if ( $taxclass ) { + $hashref->{'taxclass'} = $taxclass; + $count_query .= ( $count_query =~ /WHERE/i ? ' AND ' : ' WHERE ' ). + ' taxclass = '. dbh->quote($taxclass); +} + + +$cell_style = ''; + +my @header = ( 'Country', 'State/Province', 'County',); +my @header2 = ( '', '', '', ); +my @links = ( '', '', '', ); +my @link_onclicks = ( '', '', '', ); +my $align = 'lll'; + +my @fields = ( + sub { my $country = shift->country; + code2country($country). " ($country)"; + }, + sub { state_label($_[0]->state, $_[0]->country). + ( $_[0]->state + ? '' + : ' '. expand_link($_[0], 'Add States'). + 'add states
    ' + ) + }, + sub { $_[0]->county || '(all) '. + expand_link($_[0], 'Add Counties'). + 'add counties
    ' + }, +); + +my @color = ( + '000000', + sub { shift->state ? '000000' : '999999' }, + sub { shift->county ? '000000' : '999999' }, +); + +if ( $conf->exists('enable_taxclasses') ) { + push @header, qq!Tax class (add new)!; + push @header2, '(per-package classification)'; + push @fields, sub { $_[0]->taxclass || '(all) '. + separate_taxclasses_link($_[0], 'Separate Taxclasses'). + 'separate taxclasses' + }; + push @color, sub { shift->taxclass ? '000000' : '999999' }; + push @links, ''; + push @link_onclicks, ''; + $align .= 'l'; +} + +push @header, 'Tax name', + 'Rate', #'Tax', + 'Exemptions', + ; + +push @header2, '(printed on invoices)', + '', + '', + ; + +push @fields, + sub { shift->taxname || 'Tax' }, + sub { shift->tax. '% (edit)' }, + $exempt_sub, +; + +push @color, + sub { shift->taxname ? '000000' : '666666' }, + sub { shift->tax ? '000000' : '666666' }, + '000000', +; + +$align .= 'lrl'; + +my @cell_style = map $cell_style_sub, (1..scalar(@header)); + +push @links, '', $edit_link, ''; +push @link_onclicks, '', $edit_onclick, ''; + + diff --git a/httemplate/browse/elements/browse.html b/httemplate/browse/elements/browse.html new file mode 100644 index 000000000..513c2c4e9 --- /dev/null +++ b/httemplate/browse/elements/browse.html @@ -0,0 +1,6 @@ +<% include( '/search/elements/search.html', + 'disable_download' => 1, + 'disable_nonefound' => 1, + @_, + ) +%> diff --git a/httemplate/browse/inventory_class.html b/httemplate/browse/inventory_class.html new file mode 100644 index 000000000..8ce131ac2 --- /dev/null +++ b/httemplate/browse/inventory_class.html @@ -0,0 +1,93 @@ +<% include( 'elements/browse.html', + 'title' => 'Inventory Classes', + 'name' => 'inventory classes', + 'menubar' => [ 'Add a new inventory class' => + $p.'edit/inventory_class.html', + ], + 'query' => { 'table' => 'inventory_class', }, + 'count_query' => 'SELECT COUNT(*) FROM inventory_class', + 'header' => [ '#', 'Inventory class', 'Inventory' ], + 'fields' => [ 'classnum', + 'classname', + sub { + #my $inventory_class = shift; + my $i_c = shift; + + my $link = + $p. 'search/inventory_item.html?'. + 'classnum='. $i_c->classnum; + + my %actioncol = (); + foreach ( keys %inv_action_link ) { + my($label, $baseurl, $method) = + @{ $inv_action_link{$_} }; + my $url = $baseurl. $i_c->$method(); + $actioncol{$_} = + ''. + '('. + ''. + $label. + ''. + ')'. + ''; + } + + my %num = map { + $_ => $i_c->$_(); + } keys %labels; + + [ map { + [ + { + 'data' => ''. $num{$_}. '', + 'align' => 'right', + }, + { + 'data' => $labels{$_}, + 'align' => 'left', + 'link' => ( $num{$_} + ? $link.$link{$_} + : '' + ), + }, + { 'data' => $actioncol{$_}, + 'align' => 'left', + }, + ] + } keys %labels + ]; + }, + ], + 'links' => [ $link, + $link, + '', + ], + ) +%> +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); + +tie my %labels, 'Tie::IxHash', + 'num_avail' => 'Available', # (upload batch)', + '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' + ], +); + +my $link = [ "${p}edit/inventory_class.html?", 'classnum' ]; + + diff --git a/httemplate/browse/invoice_template.html b/httemplate/browse/invoice_template.html new file mode 100644 index 000000000..0bbfb2452 --- /dev/null +++ b/httemplate/browse/invoice_template.html @@ -0,0 +1,124 @@ +<% include("/elements/header.html", 'Invoice templates') %> + +<% include('/elements/table-grid.html') %> +% my $bgcolor1 = '#eeeeee'; +% my $bgcolor2 = '#ffffff'; +% my $bgcolor = ''; + + + Template + HTML + Print/PDF (typeset) + Plaintext + + +% foreach my $templatename ( '', @templatenames ) { +% my $tname = length($templatename) ? "_$templatename" : ''; +% +% if ( $bgcolor eq $bgcolor1 ) { +% $bgcolor = $bgcolor2; +% } else { +% $bgcolor = $bgcolor1; +% } +% +% my $display = length($templatename) ? $templatename : '(Default)'; + + + + + <% $display %> + + + + +% my( $logo_label, $logo_link_label)= length( $templatename ) +% ? labels("logo_$templatename.png") +% : ( '', 'edit' ); + <% $logo_label %> Logo + (<% $logo_link_label %>) +
    + +% foreach my $suffix (qw( returnaddress notes footer), '' ) { +% my $file = "invoice_html$suffix$tname"; +% my($label, $link_label) = length($templatename) +% ? labels($file) +% : ( '', 'edit' ); + + <% $label %> <% $suffix2name{$suffix} %> + (<% $link_label %>) +
    + +% } + + + + + +% my( $logo_label, $logo_link_label)= length( $templatename ) +% ? labels("logo_$templatename.eps") +% : ( '', 'edit' ); + <% $logo_label %> Logo + (<% $logo_link_label %>) +
    + +% foreach my $suffix (qw( returnaddress notes footer smallfooter), '' ) { +% my $file = "invoice_latex$suffix$tname"; +% my($label, $link_label) = length($templatename) +% ? labels($file) +% : ( '', 'edit' ); + + <% $label %> <% $suffix2name{$suffix} %> + (<% $link_label %>) +
    + +% } + + + + + +% my( $txt_label, $txtlink_label)= +% length( $templatename ) +% ? labels("invoice_template_$templatename.png") +% : ( 'Main template', 'edit' ); + <% $txt_label %> + (<% $txtlink_label %>) + + + + + +% } + +<% include("/elements/footer.html") %> + +<%once> + +my %suffix2name = ( + 'returnaddress' => 'Return address', + 'notes' => 'Notes', + 'footer' => 'Footer', + 'smallfooter' => 'Small footer', + '' => 'Main template', +); + +my $conf = new FS::Conf; + +sub labels { + my $filename = shift; + if ( $conf->exists($filename) ) { + ( 'Custom', 'edit' ); + } else { + ( 'Standard', 'customize' ); + } +} + + +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); + +my @templatenames = $conf->invoice_templatenames; + + diff --git a/httemplate/browse/msgcat.cgi b/httemplate/browse/msgcat.cgi new file mode 100755 index 000000000..2c916dc9f --- /dev/null +++ b/httemplate/browse/msgcat.cgi @@ -0,0 +1,44 @@ +<% include('/elements/header.html', "View Message catalog", menubar( + 'Edit message catalog' => $p. "edit/msgcat.cgi", +)) %> +<% $widget->html %> +<% include('/elements/footer.html') %> +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); + +my $widget = new HTML::Widgets::SelectLayers( + 'selected_layer' => 'en_US', + 'options' => { 'en_US'=>'en_US' }, + 'layer_callback' => sub { + my $layer = shift; + my $html = "
    Messages for locale $layer
    ". table(). + "Code". + "Message"; + $html .= "en_US Message" unless $layer eq 'en_US'; + $html .= ''; + + #foreach my $msgcat ( sort { $a->msgcode cmp $b->msgcode } + # qsearch('msgcat', { 'locale' => $layer } ) ) { + foreach my $msgcat ( qsearch('msgcat', { 'locale' => $layer } ) ) { + $html .= ''. $msgcat->msgnum. ''. + ''. $msgcat->msgcode. ''. + ''. $msgcat->msg. ''; + unless ( $layer eq 'en_US' ) { + my $en_msgcat = qsearchs('msgcat', { + 'locale' => 'en_US', + 'msgcode' => $msgcat->msgcode, + } ); + $html .= ''. $en_msgcat->msg. ''; + } + $html .= ''; + } + + $html .= ''; + $html; + }, + +); + + diff --git a/httemplate/browse/nas.cgi b/httemplate/browse/nas.cgi new file mode 100755 index 000000000..b5e0ef8b7 --- /dev/null +++ b/httemplate/browse/nas.cgi @@ -0,0 +1,82 @@ +%print header('NAS ports'); +% +%my $now = time; +% +%foreach my $nas ( sort { $a->nasnum <=> $b->nasnum } qsearch( 'nas', {} ) ) { +% print $nas->nasnum. ": ". $nas->nas. " ". +% $nas->nasfqdn. " (". $nas->nasip. ") ". +% "as of ". time2str("%c",$nas->last). +% " (". &pretty_interval($now - $nas->last). " ago)
    ". +% &table(). "Nas
    Port #Global
    Port #
    ". +% "IP addressUserSinceDuration", +% ; +% foreach my $port ( sort { +% $a->nasport <=> $b->nasport || $a->portnum <=> $b->portnum +% } qsearch( 'port', { 'nasnum' => $nas->nasnum } ) ) { +% my $session = $port->session; +% my($user, $since, $pretty_since, $duration); +% if ( ! $session ) { +% $user = "(empty)"; +% $since = 0; +% $pretty_since = "(never)"; +% $duration = ''; +% } elsif ( $session->logout ) { +% $user = "(empty)"; +% $since = $session->logout; +% } else { +% my $svc_acct = $session->svc_acct; +% $user = "svcnum. "\">". +% $svc_acct->username. ""; +% $since = $session->login; +% } +% $pretty_since = time2str("%c", $since) if $since; +% $duration = pretty_interval( $now - $since ). " ago" +% unless defined($duration); +% print "". $port->nasport. "". $port->portnum. "". +% $port->ip. "$user$pretty_since". +% "$duration" +% ; +% } +% print "
    "; +%} +% +%#Time::Duration?? +%sub pretty_interval { +% my $interval = shift; +% my %howlong = ( +% '604800' => 'week', +% '86400' => 'day', +% '3600' => 'hour', +% '60' => 'minute', +% '1' => 'second', +% ); +% +% my $pretty = ""; +% foreach my $key ( sort { $b <=> $a } keys %howlong ) { +% my $value = int( $interval / $key ); +% if ( $value ) { +% if ( $value == 1 ) { +% $pretty .= +% ( $howlong{$key} eq 'hour' ? 'an ' : 'a ' ). $howlong{$key}. " " +% } else { +% $pretty .= $value. ' '. $howlong{$key}. 's '; +% } +% } +% $interval -= $value * $key; +% } +% $pretty =~ /^\s*(\S.*\S)\s*$/; +% $1; +%} +% +%#print &table(), < +%# # +%# NAS + +#this hasn't been used in ages, and isn't linked from anywhere... +die 'NAS browse not currently active'; + + diff --git a/httemplate/browse/part_bill_event.cgi b/httemplate/browse/part_bill_event.cgi new file mode 100755 index 000000000..11bc14e5c --- /dev/null +++ b/httemplate/browse/part_bill_event.cgi @@ -0,0 +1,122 @@ +<% include('/elements/header.html', 'Invoice Event Listing') %> + + Invoice events are the deprecated, old-style actions taken on open invoices. Any events still listed here should be migrated to new-style events.

    + +Add a new invoice event +

    + +<% $total %> events +<% $cgi->param('showdisabled') + ? do { $cgi->param('showdisabled', 0); + '( hide disabled events )'; } + : do { $cgi->param('showdisabled', 1); + '( show disabled events )'; } +%> +

    +% tie my %payby, 'Tie::IxHash', FS::payby->cust_payby2longname; +% tie my %freq, 'Tie::IxHash', '1d' => 'daily', '1m' => 'monthly'; +% foreach my $payby ( keys %payby ) { +% my $oldfreq = ''; +% +% my @payby_part_bill_event = +% grep { $payby eq $_->payby } +% sort { ( $a->freq || '1d') cmp ( $b->freq || '1d' ) # for now +% || $a->seconds <=> $b->seconds +% || $a->weight <=> $b->weight +% || $a->eventpart <=> $b->eventpart +% } +% @part_bill_event; +% +% +% if ( @payby_part_bill_event ) { + + + <% include('/elements/table-grid.html') %> +% my $bgcolor1 = '#eeeeee'; +% my $bgcolor2 = '#ffffff'; +% my $bgcolor; +% +% +% foreach my $part_bill_event ( @payby_part_bill_event ) { +% my $url = "${p}edit/part_bill_event.cgi?". $part_bill_event->eventpart; +% my $delay = duration_exact($part_bill_event->seconds); +% ( my $plandata = $part_bill_event->plandata ) =~ s/\n/
    /go; +% my $freq = $part_bill_event->freq || '1d'; +% my $reason = $part_bill_event->reasontext ; +% +% if ( $oldfreq ne $freq ) { + + + + param('showdisabled') ? 7 : 8 %>><% ucfirst($freq{$freq}) %> event tests for <% $payby{$payby} %> customers + + + + param('showdisabled') ? 2 : 3 %>>Event + After + Action + Reason + Options + Code + +% +% $oldfreq = $freq; +% $bgcolor = ''; +% +% } +% +% if ( $bgcolor eq $bgcolor1 ) { +% $bgcolor = $bgcolor2; +% } else { +% $bgcolor = $bgcolor1; +% } +% + + + + + <% $part_bill_event->eventpart %> +% unless ( $cgi->param('showdisabled') ) { + + + <% $part_bill_event->disabled ? 'DISABLED' : '' %> +% } + + + <% $part_bill_event->event %> + + <% $delay %> + + <% $part_bill_event->plan %> + + <% $reason %> + + <% $plandata %> + + <% $part_bill_event->eventcode %> + +% } + + +

    +% } +% } + +<% include('/elements/footer.html') %> + +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); + +my %search; +if ( $cgi->param('showdisabled') ) { +%search = (); +} else { +%search = ( 'disabled' => '' ); +} + +my @part_bill_event = qsearch('part_bill_event', \%search ); +my $total = scalar(@part_bill_event); + + diff --git a/httemplate/browse/part_event.html b/httemplate/browse/part_event.html new file mode 100644 index 000000000..4a0582633 --- /dev/null +++ b/httemplate/browse/part_event.html @@ -0,0 +1,157 @@ +<% include( 'elements/browse.html', + 'title' => 'Billing Event Definitions', + 'html_init' => $html_init, + 'name' => 'billing event definitions', + 'disableable' => 1, + 'disabled_statuspos' => 2, + 'agent_virt' => 1, + 'agent_null_right' => 'Edit global billing events', + 'agent_pos' => 3, + 'query' => { 'select' => 'part_event.*', + 'table' => 'part_event', + 'addl_from' => $join_conditions, + 'hashref' => {}, + 'order_by' => $order_conditions, + }, + 'count_query' => $count_query, + 'header' => [ '#', + 'Event', + 'Type', + 'Check freq.', + 'Conditions', + 'Action', + ], + 'fields' => [ 'eventpart', + 'event', + $eventtable_sub, + $check_freq_sub, + $conditions_sub, + $action_sub, + ], + 'links' => [ $link, + $link, + '', + '', + '', + '', + ], + 'align' => 'rllccc', + ) +%> +<%once> + +my $eventtable_labels = FS::part_event->eventtable_labels; +my $eventtable_sub = sub { $eventtable_labels->{ shift->eventtable }; }; + +my $check_freq_labels = FS::part_event->check_freq_labels; +my $check_freq_sub = sub { $check_freq_labels->{ shift->check_freq }; }; + +my $conditions_sub = sub { + my $part_event = shift; + my $addl = 0; + + [ + map { + my $part_event_condition = $_; + my %options = $part_event_condition->options; + + [ + { + 'data' => $part_event_condition->description, + 'width' => '100%', + 'align' => 'center', + 'colspan' => 2, + 'style' => ( $addl++ ? 'border-top: 1px solid gray' : '' ), + }, + ], + + map { + + my $data = $options{$_}; + if ( ref($data) ) { + $data = join('
    ', keys %$data); #XXX display hash values too? + } + + [ + { + 'data' => $part_event_condition->option_label($_). ':', + 'align' => 'right', + 'valign' => 'top', + 'size' => '-1', + }, + { + 'data' => $data, + 'align' => 'left', + 'size' => '-1', + }, + ]; + + } keys %options + + } + $part_event->part_event_condition + + ]; + +}; + +my $action_sub = sub { + my $part_event = shift; + + my %options = $part_event->options; + + [ + + [ + { + 'data' => $part_event->description, + 'width' => '100%', + 'align' => 'center', + 'colspan' => 2, + }, + ], + + map { + [ + { + 'data' => $part_event->option_label($_). ':', + 'align' => 'right', + 'size' => '-1', + }, + { + 'data' => $options{$_}, + 'align' => 'left', + 'size' => '-1', + }, + ]; + } + + keys %options + ]; + +}; + +my $link = [ $p.'edit/part_event.html?', 'eventpart' ]; + + +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Edit billing events') + || $FS::CurrentUser::CurrentUser->access_right('Edit global billing events'); + +my $html_init = + #XXX better description + 'Events are billing, collection or other actions triggered when certain '. + 'customer, invoice, package or other conditions are met.

    '. + qq!Add a new event

    !; + +my $count_query = 'SELECT COUNT(*) FROM part_event WHERE '. + $FS::CurrentUser::CurrentUser->agentnums_sql( + 'null_right' => 'Edit global billing events', + ); + +my $join_conditions = FS::part_event_condition->join_conditions_sql; +my $order_conditions = FS::part_event_condition->order_conditions_sql; + + diff --git a/httemplate/browse/part_export.cgi b/httemplate/browse/part_export.cgi new file mode 100755 index 000000000..1cd201360 --- /dev/null +++ b/httemplate/browse/part_export.cgi @@ -0,0 +1,65 @@ +<% include("/elements/header.html", "Export Listing") %> + +Provisioning services to external machines, databases and APIs.

    + +Add a new export

    + + + +<% include('/elements/table-grid.html') %> +% my $bgcolor1 = '#eeeeee'; +% my $bgcolor2 = '#ffffff'; +% my $bgcolor = ''; + + + Export + Options + + +% foreach my $part_export ( sort { +% $a->getfield('exportnum') <=> $b->getfield('exportnum') +% } qsearch('part_export',{}) +% ) { +% if ( $bgcolor eq $bgcolor1 ) { +% $bgcolor = $bgcolor2; +% } else { +% $bgcolor = $bgcolor1; +% } + + + + <% $part_export->exportnum %> + + <% $part_export->exporttype %> to <% $part_export->machine %> (edit | delete) + + + <% itable() %> +% my %opt = $part_export->options; +% foreach my $opt ( keys %opt ) { + + + <% $opt %>:  + <% encode_entities($opt{$opt}) %> + +% } + + + + + + +% } + + + +<% include('/elements/footer.html') %> + +<%init> +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); + diff --git a/httemplate/browse/part_pkg.cgi b/httemplate/browse/part_pkg.cgi new file mode 100755 index 000000000..78cb77d26 --- /dev/null +++ b/httemplate/browse/part_pkg.cgi @@ -0,0 +1,231 @@ +<% include( 'elements/browse.html', + 'title' => 'Package Definitions', + 'html_init' => $html_init, + 'name' => 'package definitions', + 'disableable' => 1, + 'disabled_statuspos' => 3, + 'agent_virt' => 1, + 'agent_null_right' => 'Edit global package definitions', + 'agent_pos' => 4, + 'query' => { 'select' => $select, + 'table' => 'part_pkg', + 'hashref' => {}, + 'order_by' => "ORDER BY $orderby", + }, + 'count_query' => $count_query, + 'header' => \@header, + 'fields' => \@fields, + 'links' => \@links, + 'align' => $align, + ) +%> +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Edit package definitions') + || $FS::CurrentUser::CurrentUser->access_right('Edit global package definitions'); + +my $select = '*'; +my $orderby = 'pkgpart'; +if ( $cgi->param('active') ) { + + $orderby = 'num_active DESC'; +} + $select = " + + *, + + ( SELECT COUNT(*) FROM cust_pkg WHERE cust_pkg.pkgpart = part_pkg.pkgpart + AND ( cancel IS NULL OR cancel = 0 ) + AND ( susp IS NULL OR susp = 0 ) + ) AS num_active, + + ( SELECT COUNT(*) FROM cust_pkg WHERE cust_pkg.pkgpart = part_pkg.pkgpart + AND ( cancel IS NULL OR cancel = 0 ) + AND susp IS NOT NULL AND susp != 0 + ) AS num_suspended, + + ( SELECT COUNT(*) FROM cust_pkg WHERE cust_pkg.pkgpart = part_pkg.pkgpart + AND cancel IS NOT NULL AND cancel != 0 + ) AS num_cancelled + + "; + +#} + +my $conf = new FS::Conf; +my $taxclasses = $conf->exists('enable_taxclasses'); + +my $html_init; +#unless ( $cgi->param('active') ) { + $html_init = qq! + One or more service definitions are grouped together into a package + definition and given pricing information. Customers purchase packages + rather than purchase services directly.

    + Add a new package definition +

    + !; +#} + +# ------ + +my $link = [ $p.'edit/part_pkg.cgi?', 'pkgpart' ]; + +my @header = ( '#', 'Package', 'Comment' ); +my @fields = ( 'pkgpart', 'pkg', 'comment' ); +my $align = 'rll'; +my @links = ( $link, $link, '' ); + +unless ( 0 ) { #already showing only one class or something? + push @header, 'Class'; + push @fields, sub { shift->classname || '(none)'; }; + $align .= 'l'; +} + +#if ( $cgi->param('active') ) { + push @header, 'Customer
    packages'; + my %col = ( + 'active' => '00CC00', + 'suspended' => 'FF9900', + 'cancelled' => 'FF0000', + #'one-time charge' => '000000', + 'charge' => '000000', + ); + my $cust_pkg_link = $p. 'search/cust_pkg.cgi?pkgpart='; + push @fields, sub { my $part_pkg = shift; + [ + map { + my $magic = $_; + my $label = $_; + if ( $magic eq 'active' && $part_pkg->freq == 0 ) { + $magic = 'inactive'; + #$label = 'one-time charge', + $label = 'charge', + } + + [ + { + 'data' => ''. + $part_pkg->get("num_$_"). + '', + 'align' => 'right', + }, + { + 'data' => $label. + ( $part_pkg->get("num_$_") != 1 + && $label =~ /charge$/ + ? 's' + : '' + ), + 'align' => 'left', + 'link' => ( $part_pkg->get("num_$_") + ? $cust_pkg_link. + $part_pkg->pkgpart. + ";magic=$magic" + : '' + ), + }, + ], + } (qw( active suspended cancelled )) + ]; }; + $align .= 'r'; +#} + +push @header, 'Frequency'; +push @fields, sub { shift->freq_pretty; }; +$align .= 'l'; + +if ( $taxclasses ) { + push @header, 'Taxclass'; + push @fields, sub { shift->taxclass() || ' '; }; + $align .= 'l'; +} + +push @header, 'Plan', + 'Data', + 'Services'; + #'Service', 'Quan', 'Primary'; + +push @fields, sub { shift->plan || '(legacy)' }, + + sub { + my $part_pkg = shift; + if ( $part_pkg->plan ) { + + [ map { + /^(\w+)=(.*)$/; #or something; + [ + { 'data' => $1, + 'align' => 'right', + }, + { 'data' => $part_pkg->format($1,$2), + 'align' => 'left', + }, + ]; + } + split(/\n/, $part_pkg->plandata) + ]; + + } else { + + [ map { [ + { 'data' => uc($_), + 'align' => 'right', + }, + { + 'data' => $part_pkg->$_(), + 'align' => 'left', + }, + ]; + } + (qw(setup recur)) + ]; + + } + + }, + + sub { + my $part_pkg = shift; + + [ map { + my $pkg_svc = $_; + my $part_svc = $pkg_svc->part_svc; + my $svc = $part_svc->svc; + if ( $pkg_svc->primary_svc =~ /^Y/i ) { + $svc = "$svc (PRIMARY)"; + } + $svc =~ s/ +/ /g; + + [ + { + 'data' => ''. $pkg_svc->quantity. '', + 'align' => 'right' + }, + { + 'data' => $svc, + 'align' => 'left', + 'link' => $p. 'edit/part_svc.cgi?'. + $part_svc->svcpart, + }, + ]; + } + sort { $b->primary_svc =~ /^Y/i + <=> $a->primary_svc =~ /^Y/i + } + $part_pkg->pkg_svc + + ]; + + }; + +$align .= 'lrl'; #rr'; + +# -------- + +my $count_query = 'SELECT COUNT(*) FROM part_pkg WHERE '. + $FS::CurrentUser::CurrentUser->agentnums_sql( + 'null_right' => 'Edit global package definitions', + ); + + diff --git a/httemplate/browse/part_referral.html b/httemplate/browse/part_referral.html new file mode 100755 index 000000000..9cc32c459 --- /dev/null +++ b/httemplate/browse/part_referral.html @@ -0,0 +1,181 @@ +<% include("/elements/header.html","Advertising source Listing" ) %> + +Where a customer heard about your service. Tracked for informational purposes. +

    + +Add a new advertising source +

    + +<% include('/elements/table-grid.html') %> +% my $bgcolor1 = '#eeeeee'; +% my $bgcolor2 = '#ffffff'; +% my $bgcolor = ''; + + + Advertising source +% if ( $show_agentnums ) { + + Agent +% } + + >Customers and Packages + +% for my $period ( keys %after ) { + + <% $period %> +% } + + + +%foreach my $part_referral ( FS::part_referral->all_part_referral(1) ) { +% +% if ( $bgcolor eq $bgcolor1 ) { +% $bgcolor = $bgcolor2; +% } else { +% $bgcolor = $bgcolor1; +% } +% +% $a = 0; + + + + +% if ( $part_referral->agentnum || $curuser->access_right('Edit global advertising sources') ) { +% $a++; +% + + +% } + + <% $part_referral->refnum %><% $a ? '' : '' %> + +% if ( $a ) { + + +% } + + <% $part_referral->referral %><% $a ? '' : '' %> +% if ( $show_agentnums ) { + + <% $part_referral->agentnum ? $part_referral->agent->agent : '(global)' %> +% } +% for my $period ( keys %after ) { +% my @param = ( $part_referral->refnum, +% $today-$after{$period}, +% $today+$before{$period}, +% ); +% $cust_sth->execute(@param) or die $cust_sth->errstr; +% my $num_cust = $cust_sth->fetchrow_arrayref->[0]; +% $pkg_sth->execute(@param) or die $pkg_sth->errstr; +% my $num_pkg = $pkg_sth->fetchrow_arrayref->[0]; + + + + + + + + + + + +
    <% $num_cust %>customers
    <% $num_pkg %>packages
    + +% } + + +% } +% +% $cust_statement =~ s/AND refnum = \?//; +% $cust_sth = dbh->prepare($cust_statement) +% or die dbh->errstr; +% $pkg_statement =~ s/AND h_pkg_referral\.refnum = \?//; +% $pkg_sth = dbh->prepare($pkg_statement) +% or die dbh->errstr; + + + Total +% for my $period ( keys %after ) { +% my @param = ( $today-$after{$period}, +% $today+$before{$period}, +% ); +% $cust_sth->execute( @param ) or die $cust_sth->errstr; +% my $num_cust = $cust_sth->fetchrow_arrayref->[0]; +% $pkg_sth->execute(@param) or die $pkg_sth->errstr; +% my $num_pkg = $pkg_sth->fetchrow_arrayref->[0]; + + + + + + + + + + + +
    <% $num_cust %>customers
    <% $num_pkg %>packages
    + + +% } + + + + + +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Edit advertising sources') + || $FS::CurrentUser::CurrentUser->access_right('Edit global advertising sources'); + +my $today = timelocal(0, 0, 0, (localtime(time))[3..5] ); + +tie my %after, 'Tie::IxHash', + 'Today' => 0, + 'Yesterday' => 86400, # 60sec * 60min * 24hrs + 'Past week' => 518400, # 60sec * 60min * 24hrs * 6days + 'Past 30 days' => 2505600, # 60sec * 60min * 24hrs * 29days + 'Past 60 days' => 5097600, # 60sec * 60min * 24hrs * 59days + 'Past 90 days' => 7689600, # 60sec * 60min * 24hrs * 89days + 'Past 6 months' => 15724800, # 60sec * 60min * 24hrs * 182days + 'Past year' => 31486000, # 60sec * 60min * 24hrs * 364days + 'Total' => $today, +; +my %before = ( + 'Today' => 86400, # 60sec * 60min * 24hrs + 'Yesterday' => 0, + 'Past week' => 86400, # 60sec * 60min * 24hrs + 'Past 30 days' => 86400, # 60sec * 60min * 24hrs + 'Past 60 days' => 86400, # 60sec * 60min * 24hrs + 'Past 90 days' => 86400, # 60sec * 60min * 24hrs + 'Past 6 months' => 86400, # 60sec * 60min * 24hrs + 'Past year' => 86400, # 60sec * 60min * 24hrs + 'Total' => 86400, # 60sec * 60min * 24hrs +); + +my $curuser = $FS::CurrentUser::CurrentUser; + +my $show_agentnums = ( scalar($curuser->agentnums) > 1 ); + +my $cust_statement = "SELECT COUNT(*) FROM h_cust_main + WHERE history_action = 'insert' + AND refnum = ? + AND history_date >= ? + AND history_date < ? + AND ". $curuser->agentnums_sql; +my $cust_sth = dbh->prepare($cust_statement) + or die dbh->errstr; + +my $pkg_statement = "SELECT COUNT(*) FROM h_pkg_referral + LEFT JOIN cust_pkg USING ( pkgnum ) + LEFT JOIN cust_main USING ( custnum ) + WHERE history_action = 'insert' + AND h_pkg_referral.refnum = ? + AND history_date >= ? + AND history_date < ? + AND ". $curuser->agentnums_sql; +my $pkg_sth = dbh->prepare($pkg_statement) + or die dbh->errstr; + + diff --git a/httemplate/browse/part_svc.cgi b/httemplate/browse/part_svc.cgi new file mode 100755 index 000000000..f1b283638 --- /dev/null +++ b/httemplate/browse/part_svc.cgi @@ -0,0 +1,215 @@ +<% include('/elements/header.html', 'Service Definition Listing') %> + + + + Service definitions are the templates for items you offer to your customers.

    + +
    +Add a new service definition +% if ( @part_svc ) { + or  +% } + +

    + +<% $total %> service definitions +<% $cgi->param('showdisabled') + ? do { $cgi->param('showdisabled', 0); + '( hide disabled services )'; } + : do { $cgi->param('showdisabled', 1); + '( show disabled services )'; } +%> +% $cgi->param('showdisabled', ( 1 ^ $cgi->param('showdisabled') ) ); + +<% include('/elements/table-grid.html') %> +% my $bgcolor1 = '#eeeeee'; +% my $bgcolor2 = '#ffffff'; +% my $bgcolor = ''; + + + + # + +% if ( $cgi->param('showdisabled') ) { + Status +% } + + Service + + Table + + Customer
    Services
    + + Export + + Field + + Modifier + + + +% foreach my $part_svc ( @part_svc ) { +% my $svcdb = $part_svc->svcdb; +% my $svc_x = "FS::$svcdb"->new( { svcpart => $part_svc->svcpart } ); +% my @dfields = $svc_x->fields; +% push @dfields, 'usergroup' if $svcdb eq 'svc_acct'; #kludge +% my @fields = +% grep { $svc_x->pvf($_) +% or $_ ne 'svcnum' && $part_svc->part_svc_column($_)->columnflag } +% @dfields ; +% my $rowspan = scalar(@fields) || 1; +% my $url = "${p}edit/part_svc.cgi?". $part_svc->svcpart; +% +% if ( $bgcolor eq $bgcolor1 ) { +% $bgcolor = $bgcolor2; +% } else { +% $bgcolor = $bgcolor1; +% } + + + + + CLASS="grid" BGCOLOR="<% $bgcolor %>"> + <% $part_svc->svcpart %> + + +% if ( $cgi->param('showdisabled') ) { + CLASS="grid" BGCOLOR="<% $bgcolor %>"> + <% $part_svc->disabled + ? 'Disabled' + : 'Enabled' + %> + +% } + + CLASS="grid" BGCOLOR="<% $bgcolor %>"> + <% $part_svc->svc %> + + CLASS="grid" BGCOLOR="<% $bgcolor %>"> + <% $svcdb %> + + CLASS="grid" BGCOLOR="<% $bgcolor %>"> + <% $num_active_cust_svc{$part_svc->svcpart} %> <% $num_active_cust_svc{$part_svc->svcpart} ? svc_url( 'ahref' => 1, 'm' => $m, 'action' => 'search', 'part_svc' => $part_svc, 'query' => "svcpart=". $part_svc->svcpart ) : '' %>active + +% if ( $num_active_cust_svc{$part_svc->svcpart} ) { +
    [ change ] +% } + + + + CLASS="inv" BGCOLOR="<% $bgcolor %>"> + +% +%# my @part_export = +%map { qsearchs('part_export', { exportnum => $_->exportnum } ) } qsearch('export_svc', { svcpart => $part_svc->svcpart } ) ; +% foreach my $part_export ( +% map { qsearchs('part_export', { exportnum => $_->exportnum } ) } +% qsearch('export_svc', { svcpart => $part_svc->svcpart } ) +% ) { +% + + + + +% } + +
    <% $part_export->exportnum %>: <% $part_export->exporttype %> to <% $part_export->machine %>
    + + +% unless ( @fields ) { +% for ( 1..3 ) { + +% } +% } +% +% my($n1)=''; +% foreach my $field ( @fields ) { +% my $formatter = +% FS::part_svc->svc_table_fields($svcdb)->{$field}->{format} +% || sub { shift }; +% my $flag = $part_svc->part_svc_column($field)->columnflag; +% + + <% $n1 %> + <% $field %> + <% $flag{$flag} %> + + +% my $value = &$formatter($part_svc->part_svc_column($field)->columnvalue); +% if ( $flag =~ /^[MA]$/ ) { +% $inventory_class{$value} +% ||= qsearchs('inventory_class', { 'classnum' => $value } ); +% + + <% $inventory_class{$value} + ? $inventory_class{$value}->classname + : "WARNING: inventory_class.classnum $value not found" %> +% } else { + + <% $value %> +% } + + +% $n1=""; +% } +% + + +% } + + + + +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); + +#code duplication w/ edit/part_svc.cgi, should move this hash to part_svc.pm +my %flag = ( + '' => '', + 'D' => 'Default', + 'F' => 'Fixed (unchangeable)', + 'S' => 'Selectable choice', + #'M' => 'Manual selection from inventory', + 'M' => 'Manual selected from inventory', + #'A' => 'Automatically fill in from inventory', + 'A' => 'Automatically filled in from inventory', + 'X' => 'Excluded', +); + +my %search; +if ( $cgi->param('showdisabled') ) { + %search = (); +} else { + %search = ( 'disabled' => '' ); +} + +my @part_svc = + sort { $a->getfield('svcpart') <=> $b->getfield('svcpart') } + qsearch('part_svc', \%search ); +my $total = scalar(@part_svc); + +my %num_active_cust_svc = map { $_->svcpart => $_->num_cust_svc } @part_svc; + +if ( $cgi->param('orderby') eq 'active' ) { + @part_svc = sort { $num_active_cust_svc{$b->svcpart} <=> + $num_active_cust_svc{$a->svcpart} } @part_svc; +} elsif ( $cgi->param('orderby') eq 'svc' ) { + @part_svc = sort { lc($a->svc) cmp lc($b->svc) } @part_svc; +} + +my %inventory_class = (); + + diff --git a/httemplate/browse/part_virtual_field.cgi b/httemplate/browse/part_virtual_field.cgi new file mode 100644 index 000000000..b18440036 --- /dev/null +++ b/httemplate/browse/part_virtual_field.cgi @@ -0,0 +1,42 @@ +<% include('/elements/header.html', 'Virtual field definitions') %> + +<% include('/elements/error.html') %> + +Add a new field

    +% foreach $dbtable (sort { $a cmp $b } keys (%pvfs)) { + +

    <%$dbtable%>

    + +<%table()%> +Field nameDescription +% foreach my $pvf (sort {$a->name cmp $b->name} @{ $pvfs{$dbtable} }) { + + + + + + <%$pvf->name%> + <%$pvf->label%> + +% } + + +% } + +<% include('/elements/footer.html') %> + +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); + +my %pvfs; +my $block; +my $p2 = popurl(2); +my $dbtable; + +foreach (qsearch('part_virtual_field', {})) { + push @{ $pvfs{$_->dbtable} }, $_; +} + + diff --git a/httemplate/browse/payment_gateway.html b/httemplate/browse/payment_gateway.html new file mode 100644 index 000000000..848c58a82 --- /dev/null +++ b/httemplate/browse/payment_gateway.html @@ -0,0 +1,94 @@ +<% include( 'elements/browse.html', + 'title' => 'Payment gateways', + 'menubar' => [ 'Agents' => $p.'browse/agent.cgi', ], + 'html_init' => $html_init, + 'name' => 'payment gateways', + 'disableable' => 1, + 'disabled_statuspos' => 1, + 'query' => { 'table' => 'payment_gateway', + 'hashref' => {}, + }, + 'count_query' => $count_query, + 'header' => [ '#', + 'Gateway', + 'Username', + 'Password', + 'Action', + 'Options', + ], + 'fields' => [ 'gatewaynum', + $gateway_sub, + 'gateway_username', + sub { ' - '; }, + 'gateway_action', + $options_sub, + ], + ) +%> + + + +<% include('/elements/footer.html') %> +<%once> + +my $html_init = qq! + Add a new payment gateway +

    + + + +!; + +my $gateway_sub = sub { + my($payment_gateway) = @_; + + my $gatewaynum = $payment_gateway->gatewaynum; + + my $html = $payment_gateway->gateway_module. ' '. qq! + + (edit) + !; + + unless ( $payment_gateway->disabled ) { + $html .= qq! + (disable) + !; + } + + $html .= ''; + + $html; + +}; + +my $options_sub = sub { + my($payment_gateway) = @_; + + #should return a structure instead of this manual formatting... + + my $html = ''; + + my %options = $payment_gateway->options; + foreach my $option ( keys %options ) { + $html .= ''. + ''; + } + $html .= '
    '. $option. ':'. $options{$option}. '
    '; + + $html; +}; + +my $count_query = 'SELECT COUNT(*) FROM payment_gateway'; + + +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); + + diff --git a/httemplate/browse/pkg_class.html b/httemplate/browse/pkg_class.html new file mode 100644 index 000000000..4f02ca22d --- /dev/null +++ b/httemplate/browse/pkg_class.html @@ -0,0 +1,31 @@ +<% include( 'elements/browse.html', + 'title' => 'Package classes', + 'html_init' => $html_init, + 'name' => 'package classes', + 'disableable' => 1, + 'disabled_statuspos' => 2, + 'query' => { 'table' => 'pkg_class', + 'hashref' => {}, + 'extra_sql' => 'ORDER BY classnum', + }, + 'count_query' => $count_query, + 'header' => [ '#', 'Class', ], + 'fields' => [ 'classnum', 'classname' ], + 'links' => [ $link, $link ], + ) +%> +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); + +my $html_init = + 'Package classes define groups of packages, for reporting and '. + 'convenience purposes.

    '. + qq!Add a package class

    !; + +my $count_query = 'SELECT COUNT(*) FROM pkg_class'; + +my $link = [ $p.'edit/pkg_class.html?', 'classnum' ]; + + diff --git a/httemplate/browse/rate.cgi b/httemplate/browse/rate.cgi new file mode 100644 index 000000000..b20c45c0c --- /dev/null +++ b/httemplate/browse/rate.cgi @@ -0,0 +1,67 @@ +<% include( 'elements/browse.html', + 'title' => 'Rate plans', + 'menubar' => [ 'Regions and Prefixes' => + $p.'browse/rate_region.html', + ], + 'html_init' => $html_init, + 'name' => 'rate plans', + 'query' => { 'table' => 'rate', + 'hashref' => {}, + 'extra_sql' => 'ORDER BY ratenum', + }, + 'count_query' => $count_query, + 'header' => [ '#', 'Rate plan', 'Rates' ], + 'fields' => [ 'ratenum', 'ratename', $rates_sub ], + 'links' => [ $link, $link, '' ], + ) +%> +<%once> + +my $sth = dbh->prepare("SELECT DISTINCT(countrycode) FROM rate_prefix") + or die dbh->errstr; +$sth->execute or die $sth->errstr; +my @all_countrycodes = map $_->[0], @{ $sth->fetchall_arrayref }; +my $all_countrycodes = join("\n", map qq(