Index: /A2P/AUTHORS
===================================================================
--- /A2P/AUTHORS	(revision 3)
+++ /A2P/AUTHORS	(revision 3)
@@ -0,0 +1,3 @@
+Guillaume Bougard (gbougard@pkg.fr)
+Christine Bougard (k@pkg.fr)
+Yves Mantel (ymantel@consultas.ch)
Index: /A2P/COPYING
===================================================================
--- /A2P/COPYING	(revision 3)
+++ /A2P/COPYING	(revision 3)
@@ -0,0 +1,674 @@
+                    GNU GENERAL PUBLIC LICENSE
+                       Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+                            Preamble
+
+  The GNU General Public License is a free, copyleft license for
+software and other kinds of works.
+
+  The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works.  By contrast,
+the GNU General Public License is 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.  We, the Free Software Foundation, use the
+GNU General Public License for most of our software; it applies also to
+any other work released this way by its authors.  You can apply it to
+your programs, too.
+
+  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.
+
+  To protect your rights, we need to prevent others from denying you
+these rights or asking you to surrender the rights.  Therefore, you have
+certain responsibilities if you distribute copies of the software, or if
+you modify it: responsibilities to respect the freedom of others.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must pass on to the recipients the same
+freedoms that you received.  You must make sure that they, too, receive
+or can get the source code.  And you must show them these terms so they
+know their rights.
+
+  Developers that use the GNU GPL protect your rights with two steps:
+(1) assert copyright on the software, and (2) offer you this License
+giving you legal permission to copy, distribute and/or modify it.
+
+  For the developers' and authors' protection, the GPL clearly explains
+that there is no warranty for this free software.  For both users' and
+authors' sake, the GPL requires that modified versions be marked as
+changed, so that their problems will not be attributed erroneously to
+authors of previous versions.
+
+  Some devices are designed to deny users access to install or run
+modified versions of the software inside them, although the manufacturer
+can do so.  This is fundamentally incompatible with the aim of
+protecting users' freedom to change the software.  The systematic
+pattern of such abuse occurs in the area of products for individuals to
+use, which is precisely where it is most unacceptable.  Therefore, we
+have designed this version of the GPL to prohibit the practice for those
+products.  If such problems arise substantially in other domains, we
+stand ready to extend this provision to those domains in future versions
+of the GPL, as needed to protect the freedom of users.
+
+  Finally, every program is threatened constantly by software patents.
+States should not allow patents to restrict development and use of
+software on general-purpose computers, but in those that do, we wish to
+avoid the special danger that patents applied to a free program could
+make it effectively proprietary.  To prevent this, the GPL assures that
+patents cannot be used to render the program non-free.
+
+  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 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. Use with the GNU Affero General Public License.
+
+  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 Affero 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 special requirements of the GNU Affero General Public License,
+section 13, concerning interaction through a network will apply to the
+combination as such.
+
+  14. Revised Versions of this License.
+
+  The Free Software Foundation may publish revised and/or new versions of
+the GNU 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 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 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 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.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This program is free software: you can redistribute it and/or modify
+    it 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.
+
+    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 General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper mail.
+
+  If the program does terminal interaction, make it output a short
+notice like this when it starts in an interactive mode:
+
+    <program>  Copyright (C) <year>  <name of author>
+    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License.  Of course, your program's commands
+might be different; for a GUI interface, you would use an "about box".
+
+  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 GPL, see
+<http://www.gnu.org/licenses/>.
+
+  The GNU General Public License does not permit incorporating your program
+into proprietary programs.  If your program is a subroutine library, you
+may consider it more useful to permit linking proprietary applications with
+the library.  If this is what you want to do, use the GNU Lesser General
+Public License instead of this License.  But first, please read
+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
Index: /A2P/ChangeLog
===================================================================
--- /A2P/ChangeLog	(revision 3)
+++ /A2P/ChangeLog	(revision 3)
@@ -0,0 +1,5 @@
+2007-10-18  Guillaume Bougard  <gbougard@pkg.fr>
+
+    * AUTHORS: Ajout des différents contributeurs
+    * COPYING: Ajout de la licence GPL v3
+    * a2p: Préparation des sources pour leur publication sous GPL
Index: /A2P/a2p/A2P/AfpJob.pm
===================================================================
--- /A2P/a2p/A2P/AfpJob.pm	(revision 3)
+++ /A2P/a2p/A2P/AfpJob.pm	(revision 3)
@@ -0,0 +1,1106 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Class to manage an AFP Job
+#
+
+package A2P::AfpJob ;
+
+use strict;
+use Time::HiRes qw(gettimeofday tv_interval) ;
+use Data::Dumper ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use A2P::Tools qw( ShortID );
+use A2P::JobStatus qw( a2pjobstate get_status ) ;
+use A2P::Status ;
+use A2P::DB qw( job_queue_update get_next_afpjob is_job_status_updated
+                a2p_db_connect a2p_db_connected get_serviceid_info
+                a2p_db_avoid_disconnect_in_forked );
+use A2P::Com qw( GetCom comJOB );
+use A2P::Client ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 1188 $ =~ /(\d[0-9.]+)\s+/ ;
+}
+our $VERSION ;
+
+my $Infos ;
+my $event ; # Private used to manage event
+our ( $notdone , $busy ) ;
+
+# Don't indent for freeze API
+$Data::Dumper::Indent = 0 ;
+$Data::Dumper::Purity = 1 ;
+$Data::Dumper::Terse  = 1 ;
+
+# Private constants
+sub _chained_request_qr { qr/^[a-z:]+$/ }
+
+sub new {
+    my $class = shift ;
+    my $mode  = shift || 0 ;
+    my $self  = { MODE => $mode, event => 0 } ;
+    bless $self , $class ;
+    #&Debug("new ".__PACKAGE__." object v$VERSION mode $mode created");
+    return $self ;
+}
+
+# Additionnal authorized actions by mode
+my $actions_by_mode = [
+    # User mode
+    [
+        'cancel',
+        #'pause',
+        #'resume',
+        #'ticket',
+        'update' ],
+    # Advanced mode
+    [ ]
+];
+
+sub actions {
+    # Return a list of possible actions by mode for this job
+    # The list is just an API binding list that can used, the caller should
+    # known how to use them with A2P::AfpJob objects
+    # start, validate & delete actions are implicit
+    my $self = shift ;
+    return @{$actions_by_mode->[$self->mode]} ;
+}
+
+sub afpspool {
+    # Set/return the AFPSPOOL for this job
+    my $self = shift ;
+    $self->{AFPSPOOL} = shift if (@_ and $_[0]);
+    return exists($self->{AFPSPOOL}) ? $self->{AFPSPOOL} : $AFPSPOOL ;
+}
+
+sub bad_request {
+    # Set/return the BAD REQUEST status
+    my $self = shift ;
+    $self->{BAD_REQUEST} = shift if @_ ;
+    return defined($self->{BAD_REQUEST}) ? $self->{BAD_REQUEST} : 0 ;
+}
+
+sub cancel {
+    # Cancel this job
+    my $self = shift ;
+
+    # Check if it's an event request
+    return $event > 0 ? 1 : 0
+        if ($event = $self->is_event_request($_[0],'cancel'));
+
+    # Initialization
+    my $name = $self->name ;
+
+    # Check we are knowing the service
+    my $service = $self->service ;
+    unless ($service) {
+        $self->error("Service for this job is not known");
+        return 0 ;
+    }
+
+    &Info("Cancelling A2P::AfpJob $name on service '$service'");
+    $self->info("Cancelling");
+
+    # Fork before
+    my $forked = fork ;
+    if (defined($forked)) {
+        if ($forked) {
+            &Info("Cancelling $name job...");
+            &Debug("Forked process to cancel $name" . ( $self->service ?
+                " on " . $self->service : "") )
+                if ($ADVANCED_DEBUGGING);
+            return 1 ;
+
+        } else {
+            &Debug("Cancelling $name job ");
+
+            # Set environment as in service
+            $self->fake_service ;
+
+            # Don't close DB connection when my job is done
+            &a2p_db_avoid_disconnect_in_forked();
+
+            # Get status object
+            my $status = $self->get_status_object ;
+            unless ($status) {
+                &Error("Can't get Status object of $name");
+                exit ;
+            }
+
+            # Initialize jobstatus
+            $self->report("Cancelling");
+            &a2pjobstate( $status->{AFP} , 12 , 'o',
+                {
+                    JOBID  => $name,
+                    STATUS => 'CANCELLING',
+                    INFOS  => 'Cancelling'
+                } )
+                or &Info("Can't set '$name' job status");
+
+            ( $notdone , $busy ) = ( 1, 0 ) ;
+            my $resync_timer = [ &gettimeofday() ] ;
+
+            # Try to cancel the job
+            while ( $notdone > 0 and $notdone <= 10 ) {
+                my @ret = &TellListener( $service,
+                    JobManager => &GetCom( comJOB , $name => 'cancel' ),
+                    sub {
+                        while (@_) {
+                            my $info = shift ;
+                            &Debug("Cancel $name: $info")
+                                if ($ADVANCED_DEBUGGING);
+                            $self->report($info);
+                            $notdone = 0 if ( $info =~ /^CANCEL.*OK$/i );
+                            $notdone = -1
+                                if ( $info =~ /ANSWERED REQUEST TIME OUT/
+                                or $info =~ /CANCEL.*KO/ );
+                            $busy++
+                                if ($info =~ /^ERROR.*MAX JOBS COUNT REACHED$/);
+                        }
+
+                        # Resync object in DB after a while
+                        if ( &tv_interval($resync_timer) > 5 ) {
+                            $resync_timer = [ &gettimeofday() ] ;
+                            $self->sync_with_jobs_queue('on_cancel') ;
+                        }
+                    });
+
+                &Debug("Cancel $name on $service returned '@ret'")
+                    if ( $ADVANCED_DEBUGGING and @ret );
+
+                if ( $notdone > 0 ) {
+                    last unless ( $notdone < 10 or $busy );
+                    &Warn("Job $name cancel not done, retrying soon");
+                    sleep 2 ;
+                    &Info("Cancelling again $name job");
+                    $notdone ++ unless $busy ;
+                    $busy = 0 ;
+                }
+            }
+
+            if ($notdone) {
+                $self->error("Job $name seems not cancelled");
+                &Warn("Job $name seems not cancelled");
+
+            } else {
+                &Info("Job $name cancelled");
+                &a2pjobstate( $status->{AFP} , 12 , 'o',
+                    {
+                        JOBID  => $name,
+                        INFOS  => 'Cancelled'
+                    } )
+                    or &Info("Can't set info on '$name' job status");
+            }
+
+            # Reset event and resync object in DB before quitting
+            $self->unset_event ;
+
+            exit $notdone ;
+        }
+
+    } else {
+        &Warn("Can't fork to cancel $name job: $!");
+    }
+
+    return 1 ;
+}
+
+sub date {
+    # Set/return a date information for this jobs as seconds since EPOCH
+    my $self = shift ;
+    $self->{DATE} = shift if (@_ and $_[0]);
+    return exists($self->{DATE}) ? $self->{DATE} : time ;
+}
+
+sub delete {
+    # Just delete the job from the queue
+    my $self = shift ;
+
+    my ( $name, $jid ) = ( $self->name, $self->{jid} );
+    &Debug("Deletion of $name (row $jid)");
+
+    # We set the revision to a negative value and update the object
+    return &job_queue_update( $jid, 0, 0, $name, '', -1 ) ;
+}
+
+sub details {
+    # TODO implement
+    # Return any useful informations for advanced mode
+    my $self = shift ;
+    return $self->infos ;
+}
+
+sub enqueue {
+    # Enqueue the A2P::AfpJob in DB table
+    my $self = shift ;
+    my $errs = $self->error ; # Get the current errors count
+
+    # 1. Set the mode if specified, or set it to user mode
+    $self->mode(@_ ? $_[0] : 0 );
+
+    # 2. Force to synchronize us in jobs_queue
+    # TODO Better check if the status is still in diagnostics table
+    $self->sync_with_jobs_queue(1);
+
+    # Return true if no new error has been set
+    return $self->error == $errs ? 1 : 0 ;
+}
+
+sub enqueue_status {
+    # Enqueue the A2P::Status for this job in DB table
+    my $self = shift ;
+    my $status = shift ;
+
+    # A chained request must be composed of lower case and char ':' as separator
+    my $chained = shift || '' ;
+
+    $self->{STATUS_OBJECT} = $status ;
+    $self->name($status->is_job);
+    $self->jobname($status->{AFP});
+    &Info("Enqueuing ".$status->is_job." in jobs_queue table...");
+
+    # Enqueue in diagnostics table
+    return &Error("AfpJob ".$self->name." not enqueued")
+        unless ($self->enqueue);
+
+    # Just ask update if not doing chained request
+    return $self->update
+        unless ( $chained =~ _chained_request_qr );
+
+    # Just ask for the event chained request
+    &Info("Requesting '$chained' events on ".$self->name);
+    return $event > 0 ? 1 : 0
+        if ( $event = $self->is_event_request( $self->lockid, $chained ) );
+}
+
+sub error {
+    # Add an error message, return an array of errors line
+    # The error status will be true if any error message is set
+    my $self = shift ;
+    push @{$self->{ERRORS}}, @_ if (@_);
+    return exists($self->{ERRORS}) ? @{$self->{ERRORS}} : () ;
+}
+
+sub fake_service {
+    # Update environment to fake a service
+    my $self = shift ;
+    $LOCKID = $self->lockid ;
+    $SCAN_SPOOL = 1 ;
+    $KEEP_JOBSTATUS = 1 ;
+
+    # Also consolidate db connection
+    $RECONNECT_TIMER = 0 ;
+    &a2p_db_connect ;
+}
+
+sub file {
+    # Set/return path to AFP file
+    my $self = shift ;
+    my $file = $self->{FILE} || '' ;
+
+    # Get the file from status if still not available or set
+    unless ($file) {
+        my $status = $self->get_status_object ;
+        $file = $status->{FILE} if (exists($status->{FILE}));
+    }
+
+    # We need to set the full path to file
+    my $afpspool = $self->afpspool ;
+    if ( $file and $file !~ m|^/| and $afpspool ) {
+        &Debug("Trying file '$file' in '$afpspool' as spool")
+            if ($ADVANCED_DEBUGGING);
+        $file = $afpspool . '/' . $file ;
+
+    } else {
+        my $jobname = $self->jobname ;
+        my $folder = $afpspool . '/' . $self->lockid ;
+        &Debug("Searching jobname '$jobname' in '$folder' folder")
+            if ($ADVANCED_DEBUGGING);
+        my $glob = $folder . '/*' . $jobname ;
+        my @list = glob($glob);
+        if (@list) {
+            &Debug("Trying ".(@list>1?"first of ":"")."found: @list")
+                if ($ADVANCED_DEBUGGING);
+            $file = shift @list ;
+
+        } else {
+            $file = '' ;
+            $self->error("No jobname '$jobname' found in '$folder' folder");
+        }
+    }
+
+    # Set error if job is not found
+    if ( $file and ! -d $file and -e $file ) {
+        &Debug("Found file is '$file' for ".$self->name)
+            if ($ADVANCED_DEBUGGING);
+
+    } else {
+        delete $self->{SIZE} ;
+        $self->error("File '$file' not found");
+        $file = '' ;
+    }
+
+    # Set also file size
+    $self->{SIZE} = -s $file if $file ;
+
+    return $self->{FILE} = $file ;
+}
+
+sub freeze {
+    my $self = shift ;
+    return Dumper($self) ;
+}
+
+sub get_next_from_db {
+    my $self = shift ;
+    my $service = shift ; # If provided, we are looking for event in jobs_queue
+
+    # Get the next row as a hash with column names as keys
+    my $row = &get_next_afpjob( $self->mode, $service )
+        or return 0 ;
+
+    return 0 unless (defined($row) and ref($row) =~ /^HASH/);
+
+    my $newself = &thaw($row->{THAWN}) ;
+
+    return 0 unless ( ref($newself) =~ /^A2P::AfpJob/ );
+
+    # Update info which can be not synchronized at some time
+    $newself->{jid} = $row->{JID} ;
+    $newself->{DBTIME} = $row->{DBTIME} ;
+    $newself->mode($self->mode);
+
+    $newself->sync_with_jobs_status ;
+
+    return $newself ;
+}
+
+sub _get_serviceid_of {
+    unless (&a2p_db_connected() and $Infos) {
+        &Debug("Initializing A2P::Infos object");
+        $Infos = &get_serviceid_info('check all');
+        return 0 unless $Infos ;
+    }
+    return $Infos->get_serviceid_of(@_);
+}
+
+sub get_size {
+    # return the AFP file size
+    my $self = shift ;
+    my $size = 0 ;
+    if (exists($self->{SIZE})) {
+        $size = $self->{SIZE} ;
+
+    } else {
+        my $file = $self->file ;
+        if ($file) {
+            # Stange, FILE is set but not SIZE... try again to get size
+            $! = 0 ;
+            $self->{SIZE} = $size = -s $file ;
+            $self->error("Can't get size of '$file': $!")
+                unless (defined($size));
+
+        } else {
+            $self->error("Can't know size of not found file");
+        }
+    }
+    return defined($size) ? $size : 0 ;
+}
+
+sub get_status_object {
+    # Return a status object
+    my $self = shift ;
+    return $self->{STATUS_OBJECT} if (exists($self->{STATUS_OBJECT}));
+    return $self->{STATUS_OBJECT} = new A2P::Status( {}, {} ) ;
+}
+
+sub handle_event {
+    # Check the current event and do the requested job
+    my $self = shift ;
+    return 0 unless ($self->{event} and $self->{EVENT});
+
+    # A chained request can be composed of lower case and char ':' as separator
+    my @events = grep { /^[a-z]+$/ } split( /:/, $self->{EVENT} );
+    # Remark: A chained events string should represent different event so the
+    # later test must match
+
+    # Check EVENT is really authorized
+    my @possible_actions = ( 'start' , 'validate', 'delete', $self->actions );
+
+    unless ( @events == grep { $self->{EVENT} =~ /$_/ } @possible_actions ) {
+        $self->error("Unauthorized to do '$self->{EVENT}'");
+        return 0 ;
+    }
+
+    # Really do the action
+    my  ( $ret , $deleted ) = ( 0 , 0 );
+    foreach my $todo (@events) {
+        &Debug("Doing evaluation of self->$todo on ".$self->name)
+            if ($ADVANCED_DEBUGGING);
+        unless ( $ret = eval '$self->' . $todo ) {
+            &Warn("Bad $todo event handling on ".$self->name);
+            last ;
+        }
+        $deleted ++ if ( $todo eq 'delete' );
+    }
+
+    if ($ret) {
+        &Debug("Done '".$self->{EVENT}."' on ".$self->name)
+            if ($ADVANCED_DEBUGGING);
+    } else {
+        &Error("Can't do '".$self->{EVENT}."' on ".$self->name);
+        map { &Error($_) } $self->error ;
+    }
+
+    # Anyway release events
+    $self->unset_event ;
+
+    return $ret ? ( $deleted ? -1 : 1 ) : 0 ;
+}
+
+sub info {
+    # Set info on the status object, can only be used in a2p-status service
+    my $self = shift ;
+    my $info = shift
+        or return 0 ;
+
+    my $status = $self->get_status_object ;
+    $status->{INFOS} = $info ;
+    &Debug("Information for ".$self->name." set to '$info'")
+        if ($ADVANCED_DEBUGGING);
+
+    # Set status is dirty and guaranty it will be push to status DB table
+    $status->set_dirty_bit ;
+    $status->set_dirty_bit(3) ;
+}
+
+my %afpjob_infos = (
+    DBTIME => 'Time update in DB', REV => 'diag_rev', NAME => 'jobname',
+    JOBNAME => 'afpname', JOBID => 'jobname', STATUS => 'status',
+    ERRORS => 'errors', FILE => 'file', SIZE => 'file_size', WARNINGS => 'warn',
+    DESTIDS => 'destid', jid => 'db_jid', EVENT => 'event', REPORTS => 'report',
+    SERVICE => 'a2p_service', AFPSPOOL => 'a2p_afpspool',
+    ZIPFILE => 'a2p_zipfile'
+);
+
+my %status_infos = (
+    STATE => 'states', REV => 'rev', LOCKID => 'lockid', STEP => 'step',
+    SID => 'status_row', JOBID => 'jobname', STATUS => 'status',
+    ABTERM => 'abterm', NBJOBS => 'nbjobs', AFP => 'afpname',
+    INFOS => 'infos', DAY => 'day', JOBS => 'jobs', RESTART => 'restart'
+);
+
+sub infos {
+    # Return any useful informations for at least user mode
+    my $self = shift ;
+    my $status = $self->get_status_object ;
+
+    # Update zipfile member
+    $self->search_zipfile ;
+
+    # Get infos from A2P::AfpJob
+    my %infos = map { $afpjob_infos{$_} =>
+        ref($self->{$_}) =~ /^array/i ?
+            join("\n", grep { length($_) } @{$self->{$_}}) : $self->{$_}
+        } keys(%afpjob_infos) ;
+
+    map { $infos{$status_infos{$_}} = ref($status->{$_}) =~ /^array/i ?
+            join("\n", grep { length($_) } @{$status->{$_}}) : $status->{$_}
+        } keys(%status_infos)
+            if ($self != $status);
+
+    # Adapt special case
+    if (exists($infos{states})) {
+        $infos{states} = join("",split(/\n/,$infos{states})) ;
+    }
+
+    # Delete any empty value
+    map { delete $infos{$_} } grep { ! length($infos{$_}) } keys(%infos);
+
+    return \%infos ;
+}
+
+sub is_abterm {
+    # Return true if the status is abterm
+    my $self = shift ;
+    return 1 if ($self->bad_request);
+    my $status = $self->get_status_object || 0 ;
+    return $status ? $status->is_abterm : 0 ;
+}
+
+sub is_done {
+    # Return true if the status is done
+    my $self = shift ;
+    my $status = $self->get_status_object || 0 ;
+    return $status ? $status->is_done : 0 ;
+}
+
+sub is_event_request {
+    # Return boolean if it's an event request, the boolean is negative if it's
+    # a faulty event request
+    my $self = shift ;
+    return 0 if ($self->{event});
+
+    # Check if lockid is provided
+    my $lockid = shift || $self->lockid ;
+
+    # A chained request must be composed of lower case and char ':' as separator
+    my $request = shift || 'update' ;
+
+    &Debug("Initiating $request on ".$self->name) if ($ADVANCED_DEBUGGING);
+    return $self->set_event_on( $request, $lockid ) ? 1 : -1 ;
+}
+
+sub jobname {
+    # Set/return the jobname
+    my $self = shift ;
+    $self->{JOBNAME} = shift if @_ ;
+    return exists($self->{JOBNAME}) ? $self->{JOBNAME} : '' ;
+}
+
+sub lockid {
+    # Set/return the lockid
+    my $self = shift ;
+    my $status = $self->get_status_object || $self ;
+    $status->{LOCKID} = shift if @_ ;
+    return exists($status->{LOCKID}) ? $status->{LOCKID} : '' ;
+}
+
+sub md5 {
+    # Set/return the md5 to AFP file
+    my $self = shift ;
+    unless (exists($self->{MD5})) {
+        my $file = $self->file ;
+        my $md5 = 0 ;
+        if ($file) {
+            my $md5cmd = qx/md5sum "$file"/ ;
+            my ( $result , $control ) = $md5cmd =~ /^(\w+)\s+(.+)$/ ;
+            if ( $control eq $file ) {
+                $md5 = $result ;
+            } else {
+                $self->warning("Can't retrieve md5 of '$file' file");
+            }
+        } else {
+            $self->warning("Can't compute md5 of not found file");
+        }
+        $self->{MD5} = $md5 ;
+    }
+    return exists($self->{MD5}) ? $self->{MD5} : 0 ;
+}
+
+sub mode {
+    # Return/set the mode
+    my $self = shift ;
+
+    if (@_) {
+        my $mode = shift || 0 ;
+        # Mode can only be 0: user mode or 1: advanced mode
+        $self->{MODE} = ($mode =~ /^\d+$/ and $mode)? 1 : 0 ;
+    }
+
+    return exists($self->{MODE}) ? $self->{MODE} : 0 ;
+}
+
+sub name {
+    # Return/set a name to identify this AFP job
+    my $self = shift ;
+
+    if (@_) {
+        my $name = shift ;
+        # Set a default name if called with a false value
+        $name = sprintf( "A2P-AFPJOB-%s", &ShortID )
+            unless (defined($name) and $name);
+        $self->{NAME} = $name ;
+    }
+
+    return $self->{NAME} = (defined($self->{NAME}) and $self->{NAME}) ?
+        $self->{NAME} : ( $self->{JOBID} ? $self->{JOBID} : (
+        $self->{JOBNAME} ? $self->{JOBNAME} : "" ));
+}
+
+sub nbjobs {
+    # Set/return the number of sub-jobs from status object
+    my $self = shift ;
+    my $status = $self->get_status_object || $self ;
+    $status->{NBJOBS} = shift if @_ ;
+    return exists($status->{NBJOBS}) ? $status->{NBJOBS} : 0 ;
+}
+
+sub open_ticket {
+    # TODO implement
+    # Open a ticket for this job
+    my $self = shift ;
+    &Debug("Opening ticket still not supported for ".$self->name);
+    return 0 ;
+}
+
+sub otherspools {
+    # Set/return the DONESPOOL & ERRORSPOOL for this job
+    my $self = shift ;
+    $self->{DONESPOOL}  = shift if (@_ and $_[0]);
+    $self->{ERRORSPOOL} = shift if (@_ and $_[0]);
+    return map { exists($self->{$_}) ? $self->{$_} : '' }
+        qw( DONESPOOL ERRORSPOOL ) ;
+}
+
+sub pause {
+    # TODO implement
+    # Pause this job
+    my $self = shift ;
+    &Debug("Pause still not supported for ".$self->name);
+    return 0 ;
+}
+
+sub report {
+    # Add reporting message, return an array of reporting lines
+    my $self = shift ;
+    push @{$self->{REPORTS}}, @_ if (@_);
+    return exists($self->{REPORTS}) ? @{$self->{REPORTS}} : () ;
+}
+
+sub resume {
+    # TODO implement
+    # Resume this paused job
+    my $self = shift ;
+    &Debug("Resume still not supported for ".$self->name);
+    return 0 ;
+}
+
+sub search_zipfile {
+    my $self = shift ;
+
+    return &Debug("DONESPOOL not set")  unless (defined($self->{DONESPOOL}));
+    return &Debug("ERRORSPOOL not set") unless (defined($self->{ERRORSPOOL}));
+    my $base = $self->lockid . '-' . $self->name ;
+
+    my @files = glob( $self->{DONESPOOL} . '/' . $base . '*.zip' );
+    push @files, glob( $self->{ERRORSPOOL} . '/' . $base . '*.zip' );
+
+    return $self->{ZIPFILE} = \@files ;
+}
+
+sub service {
+    # Set/return the service for the status object
+    my $self = shift ;
+    $self->{SERVICE} = shift if @_ ;
+    return defined($self->{SERVICE}) ? $self->{SERVICE} : '' ;
+}
+
+sub set_event_on {
+    # Set the event flag on this job in the jobs_queue table
+    my $self = shift ;
+      $event = shift ;
+
+    # Event is related to a lockid
+    my $lockid = shift || $self->lockid ;
+    unless ($lockid) {
+        $self->error("Can't set serviceid when lockid is unknown");
+        return 0 ;
+    }
+
+    # Get the serviceid for that LOCKID
+    my $serviceid = &_get_serviceid_of($lockid);
+    unless ($serviceid) {
+        $self->error("Can't found serviceid of $lockid lockid");
+        return 0 ;
+    }
+    &Debug("Got serviceid $serviceid for lockid $lockid");
+
+    my ( $name, $jid ) = ( $self->name, $self->{jid} );
+    &Debug("Setting event $serviceid on $name (row $jid)");
+
+    # Set event flag with serviceid and event callback
+    $self->{event} = $serviceid ;
+    $self->{EVENT} = $event ;
+
+    # Synchronize with table
+    return $self->sync_with_jobs_queue('event') ;
+}
+
+sub set_status_object {
+    # Set the status object
+    my $self = shift ;
+    my $status = shift ;
+    return 0 unless (ref($status) =~ /^A2P::Status/);
+    return $self->{STATUS_OBJECT} = $status ;
+}
+
+sub start {
+    # Start this job with 2 cases:
+    # 1. Called from Webmin -> we want it to be called by the right a2p-status
+    # 2. Called by a2p-status after it detects it has to start a job
+    my $self = shift ;
+
+    my $name = $self->name ;
+    unless ($self->{event}) {
+        # Check if lockid is provided
+        my $lockid = shift || $self->lockid ;
+
+        &Debug("Initiating start on $name") if ($ADVANCED_DEBUGGING);
+        return $self->set_event_on( 'start', $lockid );
+    }
+
+    # Really start now
+    my $file = $self->file ;
+
+    # Check file definition
+    unless ( $file and $file !~ m|/$| ) {
+        $self->error("File for this job is not known");
+        return 0 ;
+    }
+
+    # Check file existence
+    # TODO Add check file is good AFP file
+    unless ( ! -d $file and -e $file ) {
+        $self->error("File '$file' not available");
+        return 0 ;
+    }
+
+    # Check we are knowing the service
+    my $service = $self->service ;
+    unless ($service) {
+        $self->error("Service for this job is not known");
+        return 0 ;
+    }
+
+    &Info("Restarting A2P::AfpJob $name with file '$file'");
+    $self->info("Restarting");
+
+    # To start we would to call directly the service, but fork before
+    my $forked = fork ;
+    if (defined($forked)) {
+        if ($forked) {
+            &Debug("Forked process to restart $name on $service")
+                if ($ADVANCED_DEBUGGING);
+            return 1 ;
+
+        } else {
+            # Set environment as in service
+            $self->fake_service ;
+
+            # Don't close DB connection when my job is done
+            &a2p_db_avoid_disconnect_in_forked();
+
+            # Get status object
+            my $status = $self->get_status_object ;
+            unless ($status) {
+                &Error("Can't get Status object of $name");
+                exit ;
+            }
+
+            my $report = $self->{EVENT} =~ /delete/ ? 0 : 1 ;
+            $self->{event} = 0 if $report ;
+
+            # Initialize jobstatus with AfpName to keep restarts in mind
+            $self->report("Restarting") if ($report);
+            &a2pjobstate( $status->{AFP} , 1 , 'o',
+                {
+                    AFP    => $status->{AFP},
+                    JOBID  => $name,
+                    STATUS => 'STARTING',
+                    FILE   => $file,
+                    INFOS  => 'Restarting'
+                } )
+                or &Info("Can't initialize '$name' job status");
+
+            ( $notdone , $busy ) = ( 1, 0 ) ;
+            my $resync_timer = [ &gettimeofday() ] ;
+            my $ABTERM = "" ;
+
+            # Try to restart the job
+            while ( $notdone > 0 and $notdone <= 10 ) {
+                my @ret = &TellListener( $service,
+                    JobManager => &GetCom( comJOB , $name => $file ),
+                    sub {
+                        while (@_) {
+                            my $info = shift ;
+                            &Debug("Running $name: $info")
+                                if ($ADVANCED_DEBUGGING);
+                            $self->report($info) if ($report);
+                            $notdone = 0 if ( $info =~ /^JOBSTATUS.*OK$/i );
+                            $notdone = -1
+                                if ( $info =~ /ANSWERED REQUEST TIME OUT/
+                                or $info =~ /JOBSTATUS.*KO/ );
+                            $busy++
+                                if ($info =~ /^ERROR.*MAX JOBS COUNT REACHED$/);
+                            $ABTERM = $1
+                                if ( $info =~ /ABTERM:\s*(.*)$/i );
+                        }
+
+                        # Resync object in DB after a while
+                        if ( &tv_interval($resync_timer) > 5 ) {
+                            $resync_timer = [ &gettimeofday() ] ;
+                            $self->sync_with_jobs_queue('on_restart') ;
+                        }
+                    });
+
+                &Debug("Start $name on $service returned '@ret'")
+                    if ( $ADVANCED_DEBUGGING and @ret );
+
+                if ( $notdone > 0 ) {
+                    last unless ( $notdone < 10 or $busy );
+                    &Warn("Job $name not done, retrying soon");
+                    sleep 2 ;
+                    &Info("Retrying restart of $name job");
+                    $notdone ++ unless $busy ;
+                    $busy = 0 ;
+                }
+            }
+
+            if ($notdone) {
+                $self->error("Job $name not restarted");
+                &Error("Job $name not restarted");
+                &a2pjobstate( $status->{AFP} , 12 , 'o',
+                    {
+                        AFP    => $status->{AFP},
+                        JOBID  => $name,
+                        STATUS => 'KO',
+                        INFOS  => $ABTERM || 'Restart failed'
+                    } )
+                    or &Info("Can't set failed info on '$name' job status");
+
+            } else {
+                &a2pjobstate( $status->{AFP} , 12 , 'o',
+                    {
+                        AFP    => $status->{AFP},
+                        JOBID  => $name,
+                        INFOS  => 'Restart done'
+                    } )
+                    or &Info("Can't set info on '$name' job status");
+            }
+
+            # Reset event and resync object in DB before quitting
+            $self->unset_event if ($report);
+
+            exit $notdone ;
+        }
+    }
+
+    $self->error("Can't fork to ask $service service to restart $name");
+    return &Error("Can't fork to ask $service service to restart $name");
+}
+
+sub status {
+    # Set/return the status from status object
+    my $self = shift ;
+    return 'BAD REQUEST' if ($self->bad_request);
+    my $status = $self->get_status_object || $self ;
+    $status->{STATUS} = shift if @_ ;
+    return defined($status->{STATUS}) ? $status->{STATUS} : '' ;
+}
+
+sub step {
+    # Set/return the step from status object
+    my $self = shift ;
+    my $status = $self->get_status_object || $self ;
+    $status->{STEP} = shift if @_ ;
+    return defined($status->{STEP}) ? $status->{STEP} : 0 ;
+}
+
+sub _row_index {
+    my $self = shift ;
+    return ( $self->{jid}, $self->{MODE}, $self->{event}, $self->name,
+        $self->jobname, $self->{REV} ) ;
+}
+
+sub sync_with_jobs_queue {
+    # sync ourself to jobs_queue table in DB
+    my $self = shift ;
+
+    if ( ! ( defined($self->{jid}) and $self->{jid} )
+    or ( defined($_[0]) and $_[0] ) ) {
+        # Called with arg will push this object as new version
+        $self->{REV} = exists($self->{REV}) ? $self->{REV}+1 : 0 ;
+
+        # Call DB API with expected row
+        my $jid = &job_queue_update( $self->_row_index, $self->freeze );
+
+        # Set jid when it was unknown and it is returned, and update us in DB...
+        if (!$self->{jid} and $jid) {
+            $self->{REV} ++ ;
+            $self->{jid} = $jid ;
+            $jid = &job_queue_update( $self->_row_index, $self->freeze );
+        }
+
+        $self->error("Can't update $self->name in DB with JID $jid")
+            unless ($jid and $self->{jid} == $jid);
+
+    } else {
+        # Get the one from DB and return it if more recent
+        # The API should return a storable newer object or undef
+        my $thawn = &job_queue_update( $self->_row_index );
+
+        my $newself = &thaw($thawn) ;
+        if (ref($newself) =~ /^A2P::AfpJob/) {
+            # Only replace us to newer version if really more recent
+            $self = $newself if ($newself->{REV} >= $self->{REV});
+
+        } else {
+            $self->error("Bad object retrieved from DB (".ref($thawn).
+                ";".ref($newself).")");
+        }
+    }
+
+    # Return self as synchronized object
+    return $self ;
+}
+
+sub sync_with_jobs_status {
+    # sync ourself to jobs_status table in DB
+    my $self = shift ;
+    my $status = $self->get_status_object
+        or return &Debug("No status object for ".$self->name) ;
+
+    return &Debug("No status SID for ".$self->name)
+        unless ($status->get_sid_index);
+
+    # Reset checked in db timer
+    $status->checked_in_db_timer(0);
+    $status->check_update_in_db ;
+
+    # Return self as synchronized object
+    return $self ;
+}
+
+sub thaw {
+    my $freezed = shift ;
+    my $object = eval $freezed ;
+    return $object ;
+}
+
+sub unset_event {
+    # Set the event flag on this job in the jobs_queue table
+    my $self = shift ;
+
+    my ( $name, $jid ) = ( $self->name, $self->{jid} );
+    &Debug("Resetting event on $name (row $jid)");
+
+    # Set event flag with serviceid
+    $self->{event} = 0 ;
+    delete $self->{EVENT} ;
+
+    # Synchronize with table
+    return $self->sync_with_jobs_queue('reset_event') ;
+}
+
+sub update {
+    # Really do nothing, but this is a convenient way to update as action
+    my $self = shift ;
+
+    # Check if it's an event request
+    return $event > 0 ? 1 : 0
+        if ($event = $self->is_event_request($_[0],'update'));
+
+    &Debug("Updating informations for ".$self->name);
+    return 1 ;
+}
+
+sub validate {
+    my $self = shift ;
+
+    # Check if it's an event request
+    return $event > 0 ? 1 : 0
+        if ($event = $self->is_event_request($_[0],'validate'));
+
+    my $name = $self->name ;
+
+    # Fork before doing validation
+    my $forked = fork ;
+    if (defined($forked)) {
+        if ($forked) {
+            &Info("Validating $name job...");
+            &Debug("Forked process to validate $name" . ( $self->service ?
+                " on " . $self->service : "") )
+                if ($ADVANCED_DEBUGGING);
+            return 1 ;
+
+        } else {
+            # Set environment as in service
+            $self->fake_service ;
+
+            # Don't close DB connection when my job is done
+            &a2p_db_avoid_disconnect_in_forked();
+
+            my $status = $self->get_status_object ;
+            unless ($status) {
+                &Error("Can't get Status object of $name");
+                exit ;
+            }
+
+            # Initialise status as new status
+            &a2pjobstate( $status->{AFP} , 1 , 'V',
+                {
+                    AFP    => $status->{AFP},
+                    JOBID  => $name,
+                    STATUS => 'STARTING',
+                    INFOS  => 'Validating'
+                } )
+                or &Info("Can't initialize '$name' job status validation");
+
+            foreach my $step (2..12) {
+                my $state = $status->step_status($step);
+                next unless ($state eq 'A');
+                &Debug("Validating $name step $step...");
+                &a2pjobstate( $status->{AFP} , $step , 'o',
+                    {
+                        JOBID  => $name,
+                        STATUS => 'DONE',
+                        INFOS  => 'Validating'
+                    } )
+                    or &Warn("Can't validate '$name' job status at step $step");
+            }
+
+            # Validate jobstatus
+            if ( &a2pjobstate( $status->{AFP} , 12 , 'o', {
+                JOBID  => $name,
+                STATUS => 'DONE',
+                INFOS  => 'Validated'
+            } ) ) {
+                &Info("Validated $name job");
+
+            } else {
+                &Error("Can't validate '$name' job status");
+            }
+
+            # Finally quit this forked process
+            exit ;
+        }
+
+    } else {
+        &Warn("Can't fork to validate $name status: $!");
+    }
+
+    return 1 ;
+}
+
+sub warning {
+    # Add warning message, return an array of warning lines
+    my $self = shift ;
+    push @{$self->{WARNINGS}}, @_ if (@_);
+    return exists($self->{WARNINGS}) ? @{$self->{WARNINGS}} : () ;
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
+
Index: /A2P/a2p/A2P/Archiver.pm
===================================================================
--- /A2P/a2p/A2P/Archiver.pm	(revision 3)
+++ /A2P/a2p/A2P/Archiver.pm	(revision 3)
@@ -0,0 +1,119 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+package A2P::Archiver ;
+
+# Derived class from Thread.pm
+use base qw(A2P::Thread);
+
+use strict ;
+use integer ;
+use Socket ':crlf' ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use A2P::archivage ;
+use A2P::Com qw( IsCom comJOB );
+use A2P::JobStatus 'a2pjobstate' ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 397 $ =~ /(\d[0-9.]+)\s+/ ;
+}
+our $VERSION ;
+
+################################################################################
+##          Archivage thread object                                           ##
+################################################################################
+sub Do {
+    my $self = shift ;
+    my $ref  = shift ;
+
+    my $Ret = 0 ;
+
+    my @Job = &IsCom( comJOB , $$ref );
+
+    if ( @Job == 2 ) {
+        my ( $Job , $archreq ) = @Job ;
+
+        &Debug("Received Arch request for $Job");
+
+        $archreq =~ s/\.arch$// ; # Squeezes arch extension
+
+        # Keep internal stats
+        &UPSTAT('ARCH_REQ');
+
+        # Archivage main sub-routine connector
+        if ( $ARCH_ENABLED < 100 ) {
+            $Ret = &ArchivageMain( $archreq );
+
+        } else {
+            # Archivage must be simulated
+            $Ret = $ARCH_ENABLED == 100 ? 0 :
+                ( rand($ARCH_ENABLED) > 99 ? 1 : 0 ) ;
+        }
+
+        # Keep status and log error
+        my $status_step = 'o' ;
+        my $status = { JID => $Job , STATUS => 'ARCHIVED' } ;
+
+        if ($Ret) {
+            $self->ThisError("Archivage of '$archreq.pdf' returned with $Ret" .
+                ( ($!) ? ": $! $? $@" : "" ));
+            $status->{ABTERM} = 'Not archived';
+            $status->{STATUS} = 'KO' ;
+            $status_step = 'A' ;
+        }
+
+        my ( $JobId ) = $Job =~ /^(.*)-\d+$/ ;
+        &a2pjobstate( $JobId || $Job , 10, $status_step, $status )
+            or &Info("Can't set job status '$status_step'");
+
+        # Keep internal stats
+        $Ret ? &UPSTAT('BAD_ARCH_REQ') : &UPSTAT('GOOD_ARCH_REQ');
+
+        $self->Return( $Job , $Ret ? $Ret : DONE );
+        $self->AnswerDone( $Job );
+
+    } else {
+        # Keep internal stats
+        &UPSTAT('BAD_ARCH_FORMAT');
+
+        $self->ThisError("Can't understand request '$$ref'");
+
+        $Ret = 9 ;
+
+        if (@Job) {
+            # Return exec status even for bad format to not break job processing
+            $self->Return( $Job[0] , $Ret );
+            $self->AnswerDone( $Job[0] );
+        }
+    }
+
+    return $Ret ? 0 : 1 ;
+}
+
+sub ThreadInit {
+    undef $SOCK ;
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
Index: /A2P/a2p/A2P/BackEnd.pm
===================================================================
--- /A2P/a2p/A2P/BackEnd.pm	(revision 3)
+++ /A2P/a2p/A2P/BackEnd.pm	(revision 3)
@@ -0,0 +1,186 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+package A2P::BackEnd ;
+
+# Derived class from Thread.pm
+use base qw(A2P::Thread);
+
+use strict ;
+use integer ;
+use Time::HiRes qw( usleep ) ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use A2P::Com qw( IsCom comJOB comZIP comFILE );
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 955 $ =~ /(\d[0-9.]+)\s+/ ;
+}
+our $VERSION ;
+
+################################################################################
+##             BackEnd code                                                   ##
+################################################################################
+sub Do {
+    my $self = shift ;
+    my $ref  = shift ;
+
+    my $Ret = 0 ;
+
+    my @Job = &IsCom( comJOB , $$ref );
+
+    if ( @Job == 2 ) {
+        my ( $Job , $Cmd ) = @Job ;
+
+        my ( $SigPipe , $SigChild ) = ( 0 , 0 );
+        $SIG{PIPE}  = sub { $SigPipe  ++ ; };
+        $SIG{CHILD} = sub { $SigChild ++ ; };
+
+        my $ThisCmdId = sprintf("%s-T%sCMD%03d", $Job, $$, $self->{CmdIndex});
+        $self->{CmdIndex} = 1 if ( ++ $self->{CmdIndex} > 999 );
+        &Debug("Set Id $ThisCmdId to this command");
+
+        # Keep internal stats
+        &UPSTAT('CMD-EXEC');
+
+        my $try = 0 ;
+
+        if ( @Job = &IsCom( comZIP , $Cmd ) ) {
+            # If we are cleaning making a zip file, we should process differen-
+            # tly as file list to zip can be too long for zip command line
+
+            my $command = 'zip -@' .
+                ( $COMPRESSFILES ?
+                    ( $COMPRESSFILES > 0 and
+                        $COMPRESSFILES <= 9 ? $COMPRESSFILES : 1 ) : 0 ) .
+                $ZIPOPTIONS . ' ' . $Job[0] ;
+
+            &Debug("Setting $ThisCmdId to '$command'");
+
+            my @files = split( /(?<=file>)(?=<file)/, $Job[1] );
+
+            if ( @files ) {
+                &Debug("Sending '$Job[1]' to $ThisCmdId zip process");
+                if (defined(open(*CMD , '|' . $command))) {
+                    local $\ = "\n" ;
+                    foreach my $rawfile ( @files ) {
+                        my $file = "" ;
+                        unless (( $file ) = &IsCom( comFILE , $rawfile )) {
+                            $self->ThisError("Bad file format in file list '" .
+                                $Job[1] ."'");
+                            $Ret = 260 ; # Ret will be evaluated to 5 later
+                            last ;
+                        }
+                        unless ( $file and print CMD $file ) {
+                            $self->ThisError("Can't send '$file' to " .
+                                $ThisCmdId . " zip command: $! $?");
+                            $Ret = 257 ; # Ret will be evaluated to 2 later
+                            last ;
+                        }
+                    }
+                    close(CMD);
+
+                } else {
+                    $self->ThisError("Can't open $ThisCmdId: $!");
+                    $Ret = 258 ; # Ret will be evaluated to 3 later
+                }
+
+            } else {
+                $self->ThisError("Bad to zip list format in '$Job[1]'");
+                $Ret = 259 ; # Ret will be evaluated to 4 later
+            }
+
+        } else {
+            &Debug("Starting $ThisCmdId");
+
+            # Try to do command
+            my $timeout = time + $BACKEND_RETRYTIMEOUT ;
+            while ( $try ++ < $BACKEND_RETRY ) {
+                $! = 0 ;
+                # Don't retry if command returns as expected
+                last unless ( $Ret = system( $Cmd ) );
+                &Debug("Try #$try '$Cmd' as it returned $Ret ($!)");
+                &UPSTAT('CMD-EXEC-ERR-'.$Ret);
+                last if ( time > $timeout );
+                usleep $try * $USLEEP ;
+            }
+        }
+
+        if ($Ret) {
+            # update try to real count
+            $try -- ;
+
+            &Warn("$Job: $ThisCmdId core dumped") if ($Ret & 128);
+            &Info("$Job: $ThisCmdId received signal " . ($Ret & 127))
+                if ($Ret & 127);
+            $Ret = $Ret >> 8 ;
+            $self->ThisError("$ThisCmdId returned with value $Ret after " .
+                $try . ($try<2?" try":" tries").(($!)?": '$!'":""));
+
+            # Keep internal stats
+            &UPSTAT('CMD-EXEC-FAILED');
+            $STATS{'CMD-EXEC-LAST-FAILED'} = $Job . ': ' . $Cmd ;
+
+        } else {
+            &Debug("$ThisCmdId received signal " . ($Ret & 127))
+                if ($Ret & 127);
+            $Ret = DONE ;
+
+            # Keep internal stats
+            &UPSTAT('CMD-EXEC-DONE');
+
+        }
+
+        &Debug("SIGPIPE received: $! $? $@") if $SigPipe ;
+        wait ;
+        &Debug("SIGCHLD received: $! $? $@") if $SigChild ;
+
+        &Debug("$ThisCmdId status = " .
+            (defined($means{$Ret}) ? $means{$Ret} : $Ret));
+        $self->Return( $Job , $Ret );
+        $self->AnswerDone( $Job );
+
+    } else {
+        $self->ThisError("Got bad command request '$$ref'");
+
+        $Ret = 9 ;
+
+        if (@Job) {
+            # Return exec status even for bad format to not break job processing
+            $self->Return( $Job[0] , $Ret );
+            $self->AnswerDone( $Job[0] );
+        }
+
+        # Keep internal stats
+        &UPSTAT('BA-CMD-FORMAT');
+    }
+
+    return $Ret == DONE ? 1 : 0 ;
+}
+
+sub ThreadInit {
+    $_[0]->{CmdIndex} = 1 ;
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
Index: /A2P/a2p/A2P/Client.pm
===================================================================
--- /A2P/a2p/A2P/Client.pm	(revision 3)
+++ /A2P/a2p/A2P/Client.pm	(revision 3)
@@ -0,0 +1,180 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# WARN SIGALRM is used to check time out,
+# so remember it can override a client definition
+
+package A2P::Client;
+
+use strict ;
+use Socket ;
+use IO::Socket ;
+use Time::HiRes  qw(ualarm gettimeofday tv_interval);
+use A2P::Globals ;
+use A2P::Syslog ;
+use A2P::Com   qw( IsCom GetCom comJOB comREQ comCOM comDONE comASK comUPD GetTmpFile comTEST );
+use A2P::Tools qw( ShortID );
+
+BEGIN {
+    use Exporter () ;
+    our ( $VERSION , @ISA , @EXPORT );
+    $VERSION = sprintf "%s", q$Rev: 415 $ =~ /(\d[0-9.]+)\s+/ ;
+    @ISA = qw(Exporter);
+    @EXPORT = qw(&TellListener &DoJob);
+}
+our $VERSION ;
+
+# Set OUTPUT_AUTOFLUSH
+$| = 1 ;
+
+# Last argument to TellListener can be a sub callback
+sub TellListener {
+    my $which = shift ;
+    $LISTENER = &GetTmpFile( $which . '-listener' );
+    my $callback = pop if ( ref($_[$#_]) =~ /^CODE$/ );
+    my @Default  = ( "NO RESPONSE" );
+    my @Response = ();
+    my $timer    = [ &gettimeofday() ] ;
+    my $shutdown = 0 ;
+    my $response = 0 ;
+
+    return ( "SERVICE NOT AVAILABLE" ) if ( ! -S $LISTENER );
+    return ( "NOTHING TO TELL" ) unless @_ ;
+
+    $SIG{ALRM} = sub {
+        # Check my time out
+        return unless ( &tv_interval($timer) > $CLIENT_TIMEOUT );
+        push @Default , "TIME OUT" ;
+        $shutdown ++ ;
+        shutdown SOCK , 2 ;
+    };
+
+    # Use ualarm to be advertize to check time-out
+    &ualarm( 1000000 , 1000000 );
+
+    socket(SOCK, PF_UNIX, SOCK_STREAM, 0)
+        or die "Can't open a socket: $!" ;
+
+    SOCK->autoflush(1);
+
+    connect(SOCK, pack_sockaddr_un($LISTENER))
+        or die "Can't connect to $LISTENER socket: $!" ;
+
+    my $Question = &GetCom( comREQ , TODO , &GetCom( comASK , @_ ));
+    &Debug("Asking '" . $Question . "' to $which service listener");
+
+    local $\ = "\n" ;
+
+    # Talk now with service
+    if ( print SOCK $Question ) {
+        while ( my $line = <SOCK> ) {
+            chomp $line ;
+            next unless $line ;
+
+            my @content = &IsCom( comCOM , $line );
+            my $info = @content ? $content[1] : $line ;
+
+            # Update my time-out timer
+            $timer = [ &gettimeofday() ] ;
+
+            # Will leave loop if server answer COM is DONE, but keeping info
+            if ( @content = &IsCom( comDONE , $info ) ) {
+                $info = $content[1] ;
+
+            } elsif ( $info =~ /^\d+$/ and $info == comTEST ) {
+                print SOCK &GetCom( comCOM , $$ , comDONE );
+                next ;
+            }
+
+            # Call back to client if requested
+            defined($callback) ? &$callback($info) : push @Response, $info ;
+            $response ++ ;
+
+            last if ( @content and $content[0] =~ /^done$/ );
+        }
+    }
+
+    &ualarm(0);
+
+    @Response = @Default unless $response ;
+
+    map {
+        &Debug("Listener response: '" . $_ . "'")
+    } @Response ;
+
+    shutdown SOCK , 2
+        unless $shutdown ;
+
+    return @Response ;
+}
+
+sub JustOutPut {
+    local $\ = "\n" ;
+    print @_ ;
+}
+
+sub DoJob {
+    my $which = shift ;
+    my $file  = shift ;
+
+    print "\nStarting job with [$which] service and '$file' file...\n";
+
+    # Find an suitable Id for the job
+    my ( $jid ) = $file =~ m|.*/(.+)(\.\w+)?$| ;
+    ( $jid ) = $file =~ m|/?(\w+)(\.\w+)+$| unless (defined($jid));
+    $jid = "JOB" . &ShortID(5) unless (defined($jid));
+
+    if ( $which and $file and $jid ) {
+        print "A2P JobID = $jid\n" ;
+        &TellListener( $which,
+            JobManager => &GetCom( comJOB , $jid => $file ), \&JustOutPut );
+
+    } else {
+        print "But it's impossible when an argument is missing\n" ;
+        print "Tell me which service to ask as first argument\n" unless $which ;
+        print "Tell me which file to compute as second argument\n" unless $file ;
+        print "I can't compute Job ID with '$file'\n" unless $jid ;
+    }
+}
+
+sub DoUpdate {
+    my $service  = shift ;
+    my $module   = shift ;
+    my $varname  = shift ;
+    my $value    = shift ;
+
+    #print "\nUpdating value $varname on [$which-$module] service...\n";
+
+    if ( $service and $module and $varname and defined($value) ) {
+        &TellListener( $service,
+            $module => &GetCom( comUPD , $varname => $value ), \&JustOutPut );
+
+    } else {
+        print "But it's impossible when an argument is missing\n" ;
+        #print "Tell me which service to ask as first argument\n" unless $which ;
+        #print "Tell me which file to compute as second argument\n" unless $file ;
+        #print "I can't compute Job ID with '$file'\n" unless $jid ;
+    }
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded") unless ( $0 =~ /cgi/ );
+
+1;
Index: /A2P/a2p/A2P/Com.pm
===================================================================
--- /A2P/a2p/A2P/Com.pm	(revision 3)
+++ /A2P/a2p/A2P/Com.pm	(revision 3)
@@ -0,0 +1,155 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+package A2P::Com ;
+
+use strict ;
+use Socket ;
+use Time::HiRes qw( gettimeofday usleep );
+use Fcntl qw(:flock F_SETLK F_WRLCK SEEK_SET);
+use IO::Socket ;
+use A2P::Globals ;
+
+BEGIN {
+    use Exporter ();
+
+    our ( $VERSION , @ISA , @EXPORT_OK , @TT );
+
+    $VERSION = sprintf "%s", q$Rev: 490 $ =~ /(\d[0-9.]+)\s+/ ;
+
+    @ISA = qw(Exporter);
+
+    @EXPORT_OK = qw( &IsCom &GetCom
+        &comCOM &comASK &comREQ &comLOG &comJOB &comSAY &comDONE &comINF &comTEST
+        &comZIP &comUPD &comFILE &GetTmpFile &TakeComLocking &ReleaseComLocking
+        &comXML
+        );
+
+    # Set timer ref to starting time
+    @TT = ( $^T , ( $^T * 1_000_000 ) % 1_000_000 ) unless @TT ;
+}
+our $VERSION ;
+our @TT ;
+
+#############################################################################
+##          Com tags lists                                                 ##
+#############################################################################
+# Constant tag index
+sub comCOM  ()   {   0  };
+sub comASK  ()   {   1  };
+sub comREQ  ()   {   2  };
+sub comLOG  ()   {   3  };
+sub comJOB  ()   {   4  };
+sub comSAY  ()   {   5  };
+sub comINF  ()   {   6  };
+sub comZIP  ()   {   7  };
+sub comUPD  ()   {   8  };
+sub comFILE ()   {  50  };
+sub comXML  ()   { 1111 };
+sub comTEST ()   { 8888 };
+sub comDONE ()   { 9999 };
+
+my $id = 1000 ;
+
+my %Coms = (
+    comCOM  ,  [  "<com id=", 0, " tid='"   , ""  , "'>" , "</com>" , 'COM' ],
+    comASK  ,  [  "<ask id=", 0, " for='"   , ""  , "'>" , "</ask>" , 'ASK' ],
+    comREQ  ,  [  "<req id=", 0, " to='"    , ""  , "'>" , "</req>" , 'REQ' ],
+    comLOG  ,  [  "<log id=", 0, " level='" , ""  , "'>" , "</log>" , 'LOG' ],
+    comJOB  ,  [  "<job id=", 0, " jid='"   , ""  , "'>" , "</job>" , 'JOB' ],
+    comSAY  ,  [  "<say id=", 0, " for='"   , ""  , "'>" , "</say>" , 'SAY' ],
+    comINF  ,  [  "<info id=",0, " kind='"  , ""  , "'>" , "</info>", 'INFO'],
+    comZIP  ,  [  "<zip id=", 0, " file='"  , ""  , "'>" , "</zip>" , 'ZIP' ],
+    comUPD  ,  [  "<maj id=", 0, " what='"  , ""  , "'>" , "</maj>" , 'MAJ' ],
+    comFILE ,  [  "<file id=",0, " name='"  , ""  , "'>" , "</file>", 'FILE'],
+    comDONE ,  [  "<done id=",0, ""         , ""  , ">"  , "</done>", 'DONE']
+);
+
+my %RegExp = (
+    comCOM  ,  qr|^<com +id=\d{4} +tid=(["']?)(\d+)\1 *>(.*)</com>$|i   ,
+    comASK  ,  qr|^<ask +id=\d{4} +for=(["']?)(\w+)\1 *>(.*)</ask>$|i   ,
+    comREQ  ,  qr|^<req +id=\d{4} +to=(["']?)(\w+)\1 *>(.*)</req>$|i    ,
+    comLOG  ,  qr|^<log +id=\d{4} +level=(["']?)(\w+)\1 *>(.*)</log>$|i ,
+    comJOB  ,  qr|^<job +id=\d{4} +jid=(["']?)([-0-9a-zA-Z_.]+)\1 *>(.*)</job>$|i   ,
+    comSAY  ,  qr|^<say +id=\d{4} +for=(["']?)(\w+)\1 *>(.*)</say>$|i,
+    comINF  ,  qr|^<info +id=\d{4} +kind=(["']?)([\s\w]+)\1 *>(.*)</info>$|i,
+    comZIP  ,  qr|^<zip +id=\d{4} +file=(["']?)([^\1>]+)\1 *>(.*)</zip>$|i,
+    comUPD  ,  qr|^<maj +id=\d{4} +what=(["']?)(\w+)\1 *>(.*)</maj>$|i,
+    comFILE ,  qr|^<file +id=\d{4} +name=(["']?)([^\1>]+)\1 *>(.*)</file>$|i,
+    comDONE ,  qr|^<(done) +id=\d{4}.*>(.*)</done>$|i,
+    comXML  ,  qr|^\s*<\w+.*>\s*$|s
+);
+
+sub GetCom {
+    local $" = '' ;
+    my $com = shift ;
+    $Coms{$com}->[1] = $id < 10000 ? $id ++ : ( $id = 1000 ) ;
+    $Coms{$com}->[3] = shift || "" ;
+    return "@{$Coms{$com}}[0..4]@_" . $Coms{$com}->[5] ;
+}
+
+# IsCom returns a list of matched pattern (pattern is s=choosen from first arg)
+sub IsCom {
+    if ( $_[0] > 999 ) {
+        return $_[1] =~ $RegExp{$_[0]} ;
+
+    } else {
+        @_ = $_[1] =~ $RegExp{$_[0]} ;
+        # Remove matching apos before returning
+        shift unless ( @_ and $_[0] =~ /^[^"']+$/ );
+        return @_ ;
+    }
+}
+
+sub timestamp {
+    # Keep timer in the current minute
+    my @tt = &gettimeofday() ;
+    return sprintf("%.8d > ",
+        (( $tt[0] - $TT[0] ) * 1_000_000 + ( $tt[1] - $TT[1] )) % 60_000_000 );
+}
+
+sub GetTmpFile {
+    return $SERVICE_TMP . '/' . $_[0] ;
+}
+
+sub TakeComLocking {
+    my $fh = shift ;
+    my $locked = 0 ;
+
+    if (defined($fh)) {
+        # Try non blocking exclusive lock
+        $locked = flock( $fh, LOCK_EX | LOCK_NB );
+        # Else try blocking one
+        $locked = flock( $fh, LOCK_EX ) unless ( $locked );
+
+        &UPSTAT($locked?'GOOD-COMLOCKING':'BAD-COMLOCKING');
+    }
+
+    return $locked ;
+}
+
+sub ReleaseComLocking {
+    my $fh = shift or return 0 ;
+    flock( $fh, LOCK_UN );
+}
+
+1;
Index: /A2P/a2p/A2P/Common.pm
===================================================================
--- /A2P/a2p/A2P/Common.pm	(revision 3)
+++ /A2P/a2p/A2P/Common.pm	(revision 3)
@@ -0,0 +1,357 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Some common subfunctions useful to A2P and Convertion
+#
+
+package A2P::Common;
+
+use strict;
+use A2P::Globals;
+use A2P::Syslog;
+
+BEGIN {
+    use Exporter ();
+    our ( $VERSION , @ISA , @EXPORT_OK );
+    $VERSION = sprintf "%s", q$Rev: 415 $ =~ /(\d[0-9.]+)\s+/ ;
+    @ISA = qw(Exporter);
+    @EXPORT_OK = qw(&validate &debug &initdebug &closedebug);
+}
+our $VERSION ;
+
+# Private Global Variables
+my @CHARTABLE = ();
+
+# Sub only used for compatibility with AFP2PRINT V1
+sub debug ;
+*debug = \&Debug ;
+
+sub initdebug {
+    $LOGFILENAME  = shift  ;
+    $LOGFILENAME .= '.log' ;
+}
+
+sub closedebug {}
+
+sub validate (\$ $) {
+    my $buffer = shift ;
+    my $nospacestrip = shift ;
+
+    my $space = chr(0x12); # Space mapping for overlays
+    $$buffer =~ s/$space/ /g ;
+    # Strip ending spaces
+    $$buffer =~ s/\s+$// if (!defined($nospacestrip));
+
+    return if ( length($$buffer) == 0 );
+
+    my $index = 0 ;
+    my $SPCcount = 0 ;
+
+    # Pre-computing for TeX and AFP texts
+    if ( $$buffer =~ /[\\\';\-]/ ) {
+        # Start to replace backslash as backslashs will be inserted
+        $$buffer =~ s/\\/\\textbackslash{}/g ;
+        # Substitutions made in AFP text
+        $$buffer =~ s/\'\'/\'/g ; #'
+        $$buffer =~ s/;;/;/g ;
+    }
+
+    # Return in case string is only with good chars
+    return if ( $$buffer =~ /^[a-zA-Z0-1\\;\-:=?\*\+\,]*$/ );
+
+    # Otherwise split the string and compute it again by converting needed chars from CHARTABLE
+    &Debug("Have string  '$$buffer' to validate");
+
+    # Split also on J and 7 that could be TeX redefined by FM12 font
+    my @temp = split( /(?![a-zA-IK-Z0-689])/ , $$buffer );
+
+    #&Debug("Buffer splitted in " . @temp . " parts, beginning with chars " .
+    #  join(", ",map { sprintf("0x%2X",ord($_)) } @temp ));
+    $$buffer = "" ;
+    foreach my $string ( @temp ) {
+        my $chr = ord( $string );
+        if (defined($CHARTABLE[$chr])) {
+            #&Debug("Char " . sprintf("0x%2X",$chr) . " defined to " . $CHARTABLE[$chr]);
+            if ( $CHARTABLE[$chr] eq '\SPC' ) {
+                $SPCcount ++ ;
+                next if (length($string) == 1 );
+            }
+
+            $$buffer .= ($SPCcount > 1 ?"\\LSP\{" . $SPCcount . "\}":'\SPC{}') , $SPCcount = 0 if $SPCcount ;
+
+            $$buffer .= $CHARTABLE[$chr] if ( $CHARTABLE[$chr] ne '\SPC' );
+
+            # We must protect any TeX token as necessary
+            $$buffer .= "{}" if ( $CHARTABLE[$chr] =~ /^\\.+/ and $CHARTABLE[$chr] ne '\SPC' );
+
+            $$buffer .= substr( $string , 1 ) if (length($string) > 1 );
+
+        } else {
+            #&Debug("Char " . sprintf("0x%2X",$chr) . " not defined in table");
+            $$buffer .= ($SPCcount > 1 ?"\\LSP\{" . $SPCcount . "\}":'\SPC{}') , $SPCcount = 0 if $SPCcount ;
+            $$buffer .= $string ;
+            }
+        }
+    $$buffer .= ($SPCcount > 1 ?"\\LSP\{" . $SPCcount . "\}":'\SPC{}') , $SPCcount = 0 if $SPCcount ;
+    $$buffer =~ s/;;/;/g ; # For some overlay validation
+    &Debug("Validated to '$$buffer'");
+}
+
+#=======================================================================
+# initialisation code - stuff the DATA into the CHARTABLE hash
+#=======================================================================
+{
+    my ( $code , $texcode , $comment );
+
+    &Debug("Loading CHARTABLE...");
+    while (<DATA>)
+    {
+        next unless /\S/;
+        chop;
+        s/^\s+//;
+        ( $code, $texcode , $comment ) = split(/\s+/, $_ , 3);
+        next if ( $code =~ /^skip/ );
+        $code = eval($code) if ( $code =~ /^0x/ );
+        $CHARTABLE[$code] = $texcode;
+        #&Debug("Char " . sprintf("0x%2X",$code) . " defined to '" . $CHARTABLE[$code] . "'");
+    }
+
+    close(DATA);
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
+
+__DATA__
+0x00             \SPC
+0x01             \SPC
+0x02             \SPC
+0x03             \SPC
+0x04             \SPC
+0x05             \SPC
+0x06             \SPC
+0x07             \SPC
+0x08             \SPC
+0x09             \SPC
+0x0a             \SPC
+0x0b             \SPC
+0x0c             \SPC
+0x0d             \SPC
+0x0e             \SPC
+
+0x0f             \char"27           Used to valid string value from AFP overlays
+
+0x10             \textbackslash     Used to valid string value from AFP overlays
+0x11             \char"2A           Used to valid string value from AFP overlays
+skip 0x12        \SPC         (Was used to valid string value from AFP overlays)
+0x13             \char"28           Used to valid string value from AFP overlays
+0x14             \char"29           Used to valid string value from AFP overlays
+0x15             \char"3F           Used to valid string value from AFP overlays
+0x16             \char"2E           Used to valid string value from AFP overlays
+0x17             \char"2B           Used to valid string value from AFP overlays
+0x18             \textasciicircum   Used to valid string value from AFP overlays
+0x19             \$                 Used to valid string value from AFP overlays
+0x1a             \char"5B           Used to valid string value from AFP overlays
+0x1b             \char"5D           Used to valid string value from AFP overlays
+0x1c             \{                 Used to valid string value from AFP overlays
+0x1d             \}                 Used to valid string value from AFP overlays
+0x1e             \char"2D           Used to valid string value from AFP overlays
+0x1f             \char"7C           Used to valid string value from AFP overlays
+
+0x20            \SPC                space
+0x21            \char"21            !
+0x22            \textquotedbl       "
+0x23            \#
+0x24            \$
+0x25            \%
+0x26            \&
+0x27            \char"27            '
+skip 0x28                           (
+skip 0x29                           )
+skip 0x2a                           *
+skip 0x2b                           +
+skip 0x2c                           ,
+0x2d            \char"2D            -
+skip 0x2e                           .
+0x2f            \ourslash           /
+
+0x37           \cSev                7
+
+skip 0x3a                           :
+skip 0x3b                           ;
+0x3c           \char"3C             <
+skip 0x3d           $=$             =
+0x3e           \char"3E             >
+skip 0x3f                           ?
+
+skip 0x40                           @
+
+0x4A           \cJ                  J
+
+0x5b           ffl                  [
+0x5c           \textbackslash       \
+0x5d           \textquotedblleft    ]
+0x5e           \textasciicircum     ^                Does not exist in IBM chars
+0x5f           \_
+
+skip 0x60                           `
+0x7b           \{
+0x7c           !                    IBM<!>=4F -> Latin1=7C and not \textbar    |
+0x7d           \}
+0x7e           \textasciitilde      ~
+0x7f           \SPC
+
+0x80           \SPC
+0x81           \SPC
+0x82           \SPC
+0x83           \SPC
+0x84           \textquotedblright
+0x85           \SPC
+0x86           \char"86 or \dag
+0x87           \char"87 or \ddag
+0x88           \SPC
+0x89           \SPC
+0x8a           \SPC
+0x8b           \SPC
+0x8c           \SPC
+0x8d           \SPC
+0x8e           \SPC
+0x8f           \SPC
+
+0x90           \SPC
+0x91           \SPC
+0x92           \SPC
+0x93           \SPC
+0x94           \SPC
+0x95           \SPC
+0x96           \SPC
+0x97           \SPC
+0x98           \SPC
+0x99           \SPC
+0x9a           \SPC
+0x9b           \SPC
+0x9c           \SPC
+0x9d           \SPC
+0x9e           \SPC
+0x9f           \SPC                         IBM chars not used
+
+0xA0            \SPC
+0xA1            \textexclamdown
+0xA2            \char"5B or $\lbrack$       IBM<[>=4A -> Latin1=A2 and not <?>
+0xA3            \char"A3
+0xA4            \ourbullet                  Euro symbol in ASCII
+0xA5            \SPC
+0xA6            \textbar
+0xA7            \char"A7
+0xA8            \textquoteleft
+0xA9            \char"A9
+0xAA            \char"96\char"96\setbox4\hbox{\char"96}\kern0.5\wd4   Used to replace double zero for numbers decimal part
+0xAB            \guillemotleft
+0xAC            \char"A2 or $\not\subset$
+0xAD            \ourtop or $top$
+0xAE            \char"AE
+0xAF            \textquoteleft
+
+0xB0            \char"B0
+0xB1            $)$
+0xB2            $\dashv$
+0xB3            \ourtextbar or  $\mid$
+0xB4            \textquoteright
+0xB5            \char"B5 or $\mu$
+skip 0xB6
+skip 0xB7
+0xB8            \SPC
+0xB9            \ourbot or $\bot$
+skip 0xBA
+0xBB            \guillemotright
+0xBC            \char"BC
+0xBD            \char"BD
+0xBE            \char"BE
+0xBF            \char"BF
+
+skip 0xC0
+skip 0xC1
+skip 0xC2
+skip 0xC3
+skip 0xC4
+skip 0xC5
+skip 0xC6
+skip 0xC7
+skip 0xC8
+skip 0xC9
+skip 0xCA
+skip 0xCB
+skip 0xCC
+skip 0xCD
+skip 0xCE
+skip 0xCF
+
+0xD0            \oe
+skip 0xD1
+skip 0xD2
+skip 0xD3
+skip 0xD4
+skip 0xD5
+skip 0xD6
+0xD7            \ourline                    Used in IBM to make lines
+0xD8            \ourOslash                  Used in E-Service
+skip 0xD9
+skip 0xDA
+skip 0xDB
+skip 0xDC
+0xDD            \char"20
+0xDE            \ddag
+skip 0xDF
+
+skip 0xE0
+skip 0xE1
+skip 0xE2
+skip 0xE3
+skip 0xE4
+skip 0xE5
+skip 0xE6
+skip 0xE7
+skip 0xE8
+skip 0xE9
+skip 0xEA
+skip 0xEB
+skip 0xEC
+skip 0xED
+skip 0xEE
+skip 0xEF
+
+0xF0            \dh
+skip 0xF1
+skip 0xF2
+skip 0xF3
+skip 0xF4
+skip 0xF5
+skip 0xF6
+0xF7            \char"F7 or $\div$
+skip 0xF8
+skip 0xF9
+skip 0xFA
+skip 0xFB
+skip 0xFC
+skip 0xFD
+skip 0xFE
+0xFF            \char"FF
Index: /A2P/a2p/A2P/Converter.pm
===================================================================
--- /A2P/a2p/A2P/Converter.pm	(revision 3)
+++ /A2P/a2p/A2P/Converter.pm	(revision 3)
@@ -0,0 +1,187 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+package A2P::Converter;
+
+# Derived class from Thread.pm
+use base qw(A2P::Thread AFPDS::afpds2tex);
+
+use strict ;
+use integer ;
+use Fcntl ':flock';
+use A2P::Globals ;
+use A2P::Syslog ;
+use AFPDS::afpds2tex ;
+use A2P::Com qw( IsCom GetCom comJOB comREQ );
+use A2P::Tools qw( ShortID ) ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 717 $ =~ /(\d[0-9.]+)\s+/ ;
+}
+our $VERSION ;
+
+my $LCK ;
+my $self ;
+
+################################################################################
+##             Converter code                                                 ##
+################################################################################
+sub Do {
+       $self = shift ;
+    my $ref  = shift ;
+
+    my $Ret = 0 ;
+
+    my @Job = &IsCom( comJOB , $$ref );
+
+    if ( @Job == 2 ) {
+        my ( $Job , $file ) = @Job ;
+
+        # Keep internal stats
+        &UPSTAT('CONV_REQ');
+
+    #--------------------------------------
+    # It's a file to convert by default
+    #--------------------------------------
+        my $startpos = 0 ;
+        # Check if we were ask to start an AFP file at a given position
+        ( $file, $startpos ) = ( $1, $2 ) if ( $file =~ /^(.*):(\d+)$/ );
+
+        &Debug( "Requested to convert '$file' for Job $Job".
+            ( $startpos ? ", beginning at pos $startpos" : "" ) );
+
+        # Get folder without trailing '/'
+        my ( $jobfolder ) = $SHMDIR =~ m|(.*[^/]+)/?$| ;
+        my ( $base ) = $file =~ m|([^/]+)$| ; # Get file basename
+        $jobfolder .= "/$Job-$base" ;
+
+        # Found a free folder to compute AFPDS file
+        my ( $newfolder , $tries ) = ( $jobfolder , 10 );
+        while ( $tries-- ) {
+            $! = 0 ;
+            # Use standard Perl locking as we are working on our filesystem
+            undef $LCK ;
+            open($LCK, '>>', $newfolder.".LCK")
+                or $self->ThisError("Can't open $newfolder.LCK lock file: $!"),
+                   $Ret ++, last ;
+
+            # Try non blocking exclusive lock
+            my $locked = flock($LCK, LOCK_EX | LOCK_NB);
+            &Debug("Can't lock '$newfolder.LCK': $locked, $!") unless $locked ;
+
+            # Don't use this folder name if folder exists or we don't have lock
+            last unless ( ! $locked or -d $newfolder );
+
+            close($LCK);
+
+            $newfolder = $jobfolder . '-' . &ShortID(5) ;
+        }
+        $jobfolder = $newfolder ;
+
+        if ( ! -d $jobfolder ) {
+            &Debug("Starting '$base' conversion in '$jobfolder' for Job $Job");
+
+            # self->{JOB} is necessary to return some informations to JobManager
+            # when conversion thread failed abnormally
+            # (see A2P/Thread.pm, DESTROY sub)
+            $self->{JOB} = $Job ;
+            $Ret = $self->ConvertFile( $jobfolder, $file, $Job, $startpos );
+            $self->{JOB} = "" ;
+
+            &Debug("Conversion of '$base' returned with value $Ret") if $Ret ;
+
+            # Keep internal stats
+            $Ret ? &UPSTAT('BAD_CONV_REQ') : &UPSTAT('GOOD_CONV_REQ') ;
+
+            # Check to handle splitting case
+            if ( !$Ret and
+            defined($self->{AFPDS}) and $self->{AFPDS}->issplitted() ) {
+                # Set splitting event, JobManager handles it as also DONE answer
+                $Ret = $self->{AFPDS}->getEnv ;
+                # Freeing object
+                delete $self->{AFPDS} ;
+            }
+
+            # Now return conversion status
+            $Ret = DONE unless $Ret ;
+            $self->Return( $Job , $Ret );
+            $self->AnswerDone( $Job );
+
+            # LCK file will be purge by JobManager during step 12
+            # This will release the lock on the folder
+
+        } else {
+
+            # Keep internal stats
+            &UPSTAT('BAD_CONV_JOBFOLDER');
+
+            $Ret = 50 ;
+            # Return an error status
+            $self->Return( $Job , $Ret );
+            $self->AnswerDone( $Job );
+        }
+
+    } else {
+
+        # Keep internal stats
+        &UPSTAT('BAD_CONV_REQFORMAT');
+
+        $self->ThisError("Got bad conversion request '$$ref'");
+        $Ret ++ ;
+
+        if (@Job) {
+            # Return exec status even for bad format to not break job processing
+            $self->Return( $Job[0] , $Ret );
+            $self->AnswerDone( $Job[0] );
+        }
+    }
+
+    return $Ret == DONE ? 1 : 0 ;
+}
+
+sub ThreadInit {
+    $self = shift ;
+
+    # Initializes stat headers
+    $self->{STATHEADERS} = [ qw(
+        Date      DayTime   JobID       Jobname     DestId  PageDef
+        FormDef   DocName   PageFormats CopyGroups  Logos   NbPages
+        Type      LockId
+        ) ];
+
+    $self->{HAVE_STATS} = 1 ;
+}
+
+sub END {
+    return unless (defined($self) and defined($self->{JOB}) and $self->{JOB});
+
+    print $self->getName . ": END step: $self->{JOB}\n";
+
+    # Return an error status
+    &Warn("Unexpected abort condition reached on '$self->{JOB}'");
+    $self->Return( $self->{JOB} , 254 );
+    $self->AnswerDone( $self->{JOB} );
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
Index: /A2P/a2p/A2P/DB.pm
===================================================================
--- /A2P/a2p/A2P/DB.pm	(revision 3)
+++ /A2P/a2p/A2P/DB.pm	(revision 3)
@@ -0,0 +1,2060 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+package A2P::DB ;
+
+use strict ;
+use Time::HiRes qw( gettimeofday tv_interval usleep ) ;
+use DBI ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use A2P::Infos ;
+
+BEGIN {
+    use Exporter ();
+
+    our ( $VERSION, @ISA, @EXPORT, @EXPORT_OK );
+
+    $VERSION = sprintf "%s", q$Rev: 1426 $ =~ /(\d[0-9.]+)\s+/ ;
+
+    @ISA = qw(Exporter);
+
+    # Export common API
+    @EXPORT = qw(
+        &a2p_db_connect &a2p_db_disconnect &a2p_db_connected &check_commit
+        &a2p_db_avoid_disconnect_in_forked
+        );
+
+    # Export OK jobstatus API
+    push @EXPORT_OK, qw(
+        &CheckJobsStatusTables &get_serviceid_info &job_status_update
+        &is_job_status_updated &get_next_jobstatus &job_status_delete
+        &CheckJobsQueueTable &job_queue_update &get_next_afpjob
+        );
+
+    # Export OK statistics API
+    push @EXPORT_OK, qw(
+        &a2p_db_statistics_ready &CheckJobsTables &stats_set_service
+        &stats_jobmanager &stats_converter
+        );
+}
+our $VERSION ;
+
+my $DBH ;
+my %TABLES ;
+my $CACHE ;
+
+my $JOB ;    # Array ref set in &stats_converter or &stats_jobmanager
+my $MONTH ;  # String set in &CheckJobsTables
+
+my %CREATE_TABLE = (
+    afpjobs_YYYYMM => q{
+CREATE TABLE afpjobs_YYYYMM (
+  afpjid INTEGER UNSIGNED NOT NULL AUTO_INCREMENT,
+  JobID TEXT NOT NULL,
+  serviceid INTEGER UNSIGNED NOT NULL,
+  Date VARCHAR(8) NOT NULL,
+  DayTime TIME NOT NULL,
+  State VARCHAR(2) NOT NULL,
+  Errors SMALLINT UNSIGNED NOT NULL,
+  NBJobs SMALLINT UNSIGNED NOT NULL,
+  Chrono FLOAT NOT NULL,
+  Counted TINYINT UNSIGNED NOT NULL DEFAULT 0,
+  PRIMARY KEY(afpjid),
+  INDEX jobids_index(JobID(16),serviceid)
+)
+TYPE=InnoDB;
+    },
+    jobs_YYYYMM => q{
+CREATE TABLE jobs_YYYYMM (
+  jid INTEGER UNSIGNED NOT NULL AUTO_INCREMENT,
+  afpjid INTEGER UNSIGNED NOT NULL,
+  Number SMALLINT UNSIGNED NOT NULL,
+  destid INTEGER UNSIGNED NOT NULL,
+  docid INTEGER UNSIGNED NOT NULL,
+  NbPages SMALLINT UNSIGNED NOT NULL,
+  State VARCHAR(2) NULL,
+  Timing FLOAT NOT NULL,
+  Chrono FLOAT NOT NULL,
+  Kind VARCHAR(1) NULL,
+  Errors TINYINT UNSIGNED NOT NULL,
+  Counted TINYINT UNSIGNED NOT NULL DEFAULT 0,
+  Jobname TEXT NULL,
+  PRIMARY KEY(jid),
+  UNIQUE INDEX unique_jids_index(afpjid,Number)
+)
+TYPE=InnoDB;
+    },
+    jobs_status => q{
+CREATE TABLE jobs_status (
+  sid INTEGER UNSIGNED NOT NULL AUTO_INCREMENT,
+  serviceid INTEGER UNSIGNED NULL,
+  JobID TEXT NULL,
+  Revision INTEGER UNSIGNED NULL,
+  Timer BIGINT UNSIGNED NULL,
+  Step TINYINT UNSIGNED NULL,
+  Steps VARCHAR(13) NULL,
+  Born BIGINT UNSIGNED NULL,
+  Date VARCHAR(8) NULL,
+  Jobname TEXT NULL,
+  CurrentStatus TEXT NULL,
+  NbJobs INTEGER UNSIGNED NULL,
+  DestIDs TEXT NULL,
+  Infos TEXT NULL,
+  dbtime TIMESTAMP NULL DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP,
+  PRIMARY KEY(sid),
+  INDEX jobs_status_index(serviceid, JobID(16)),
+  INDEX jobs_status_jobname_index(Jobname(16))
+)
+TYPE=InnoDB;
+    },
+    jobs_queue => q{
+# jobs_queue
+    CREATE TABLE jobs_queue (
+        jid INTEGER
+            UNSIGNED NOT NULL AUTO_INCREMENT,
+        Mode TINYINT
+            # Mode = 0 -> User mode ; Mode > 0 -> Advanced mode
+            UNSIGNED NULL,
+        serviceid INTEGER
+            UNSIGNED NULL,
+        JobID TEXT
+            NULL,
+        Jobname TEXT
+            NULL,
+        Revision INTEGER
+            UNSIGNED NULL,
+        Object TEXT
+            NULL,
+        dbtime TIMESTAMP
+            NULL DEFAULT CURRENT_TIMESTAMP
+            ON UPDATE CURRENT_TIMESTAMP,
+        PRIMARY KEY(jid),
+        INDEX mode_index(Mode,serviceid)
+    )
+    TYPE=InnoDB;
+    },
+    Services => q{
+CREATE TABLE Services (
+  serviceid INTEGER UNSIGNED NOT NULL AUTO_INCREMENT,
+  Name TEXT NOT NULL,
+  Server TEXT NOT NULL,
+  LockID TEXT NOT NULL,
+  PRIMARY KEY(serviceid),
+  UNIQUE INDEX unique_services_index(Name(20),Server(30),LockID(10))
+)
+TYPE=InnoDB;
+    },
+    Count => q{
+CREATE TABLE Count (
+  countid INTEGER UNSIGNED NOT NULL AUTO_INCREMENT,
+  serviceid INTEGER UNSIGNED NOT NULL,
+  YearMonth VARCHAR(6) NOT NULL,
+  afpjobs_nb INTEGER UNSIGNED NOT NULL,
+  afpjobs_tps FLOAT NOT NULL,
+  afpjobs_err INTEGER UNSIGNED NOT NULL,
+  jobs_nb INTEGER UNSIGNED NOT NULL,
+  jobs_err INTEGER UNSIGNED NOT NULL,
+  pages_nb INTEGER UNSIGNED NOT NULL,
+  PRIMARY KEY(countid),
+  UNIQUE INDEX unique_counts_index(serviceid,YearMonth)
+)
+TYPE=InnoDB;
+    },
+    Destinations => q{
+CREATE TABLE Destinations (
+  destid INTEGER UNSIGNED NOT NULL AUTO_INCREMENT,
+  DestIdName TEXT NOT NULL,
+  FirstTime DATE NOT NULL,
+  LastTime DATE NOT NULL,
+  Count INTEGER UNSIGNED NOT NULL,
+  PRIMARY KEY(destid),
+  UNIQUE INDEX unique_destids_index(DestIdName(8))
+)
+TYPE=InnoDB;
+    },
+    Documents => q{
+CREATE TABLE Documents (
+  docid INTEGER UNSIGNED NOT NULL AUTO_INCREMENT,
+  PageDef TEXT NOT NULL,
+  FormDef TEXT NOT NULL,
+  DocName TEXT NOT NULL,
+  PageFormats TEXT NOT NULL,
+  CopyGroups TEXT NOT NULL,
+  Logos TEXT NOT NULL,
+  FirstTime DATE NOT NULL,
+  LastTime DATE NOT NULL,
+  Count INTEGER UNSIGNED NOT NULL,
+  PRIMARY KEY(docid),
+  INDEX documents_index(PageDef(6),FormDef(6),DocName(4))
+)
+TYPE=InnoDB;
+    },
+    DocDestCount => q{
+CREATE TABLE DocDestCount (
+  ddid INTEGER UNSIGNED NOT NULL AUTO_INCREMENT,
+  destid INTEGER UNSIGNED NOT NULL,
+  docid INTEGER UNSIGNED NOT NULL,
+  FirstTime DATE NOT NULL,
+  LastTime DATE NOT NULL,
+  Count INTEGER UNSIGNED NOT NULL,
+  PRIMARY KEY(ddid),
+  UNIQUE INDEX ddids_index(destid,docid)
+)
+TYPE=InnoDB;
+    }
+);
+
+my $Server ;
+if ( -e '/proc/sys/kernel/hostname' ) {
+    open *HOSTNAME , '<', "/proc/sys/kernel/hostname"
+        or die "Can't read hostname from kernel: $!";
+    $Server = <HOSTNAME> ;
+    close HOSTNAME ;
+} else {
+    $Server = qx/hostname -s/ ;
+}
+$Server = 'unknown' unless (defined($Server) and $Server);
+chomp $Server ;
+
+# String set in &stats_set_service, used in &set_serviceid_from
+my $service = "" ;
+my $serviceid = 0 ;       # Value set in &set_serviceid_from
+my $countid = 0 ;         # Value set in &set_countid
+my $afpjid = 0 ;          # Value set in &set_afpjid_from
+my $jid = 0 ;             # Value set in &set_jid_from
+my $destid = 0 ;          # Value set in &set_destid_from
+my $docid = 0 ;           # Value set in &set_docid
+my $ddid = 0 ;            # Value set in &set_ddid
+my $actual_commit = 0 ;   # Commit counter
+my $commit_timer  = [ &gettimeofday() ] ; # Commit timer
+my @commit_timers = () ;  # Commit times to check timer adjustement
+my $max_timer = 10 ;      # 10 seconds is the max timer, will be updated
+                          # as needed but not other 10s
+
+# Set to something returning 1 only for debugging during development
+sub __A2P_DB_DEBUG__ { 0 }
+
+################################################################################
+### Common API
+################################################################################
+
+my $connected_timer = [ &gettimeofday() ] ;
+sub a2p_db_connect {
+    if ($RECONNECT_TIMER) {
+        # Force a disconnection from DB
+        if (&tv_interval($connected_timer) >= $RECONNECT_TIMER) {
+            &UPSTAT('A2P-DB-RECONNECT-TIMEOUT');
+            $connected_timer = [ &gettimeofday() ] ;
+            &a2p_db_disconnect();
+        }
+    }
+
+    # Get a connection to DB
+    $DBH = DBI->connect_cached(
+        $DBI_DSN,
+        $DBI_USER ? $DBI_USER : $Progname ,
+        $DBI_PASSWD,
+        {
+            PrintError => 1,  RaiseError => 0,  AutoCommit => 0,
+            __statistics__ => __FILE__.__LINE__,
+            Profile => 0
+            # Can be 2, 4 or 6 to profile SQL requests (see man DBI::Profile)
+        })
+        or return &Error("Can't connect to '$DBI_DSN': " . $DBI::errstr);
+    &UPSTAT('A2P-DB-CONNECT-CACHED');
+
+    return defined($DBH) ? $DBH : 0 ;
+}
+
+sub a2p_db_connected {
+    # Check we are still connected to DB
+    my $connected = (defined($DBH) and $DBH) ? 1 : 0 ;
+    &UPSTAT('A2P-DB-CONNECTED-CHECK-'.$connected);
+
+    # Force a reconnection to DB if RECONNECT_TIMER is set and delay is passed
+    $connected = &a2p_db_connect()
+        if ($RECONNECT_TIMER
+        and &tv_interval($connected_timer) >= $RECONNECT_TIMER);
+
+    # Disconnect on error detection
+    if ( $connected and defined($DBH->err()) and $DBH->err() ) {
+        &Error("Disconnecting on DBI error detection: " . $DBH->errstr());
+        $connected = 0 ;
+    }
+
+    # Check the ping status a try reconnect is False
+    unless ( $connected and $DBH->ping ) {
+        &Info("DB Disconnection detected, reconnecting...") if $connected ;
+        &a2p_db_disconnect();
+        $connected = &a2p_db_connect();
+    }
+
+    return $connected ;
+}
+
+sub a2p_db_disconnect {
+    my @caller = caller ;
+    local $" = '-' ;
+    $caller[1] =~ s/.*\/// ;
+    &UPSTAT("A2P-DB-DISCONNECT-@caller");
+
+    if (defined($DBH)) {
+        # Check if profile was enabled and then dump as Debug
+        if (defined($DBH->{Profile}) and $DBH->{Profile}) {
+            &Debug("DB profiling: " . $DBH->{Profile}->format);
+        }
+
+        if ($actual_commit) {
+            # Force commit immediatly before disconnection
+            $actual_commit = $STATS_COMMIT_SKIP ;
+            &commit();
+            usleep 10000 ;
+        }
+
+        # Disconnect DB if present
+        $DBH->disconnect();
+        &UPSTAT('A2P-DB-DISCONNECTED');
+
+        # Erase DBH handler
+        undef $DBH ;
+
+        # Erase Some related variables
+        map { delete $TABLES{$_} } keys(%TABLES) ;
+    }
+}
+
+
+################################################################################
+### Private API
+################################################################################
+
+sub CheckTable {
+    my $name = shift ;
+    my $sub  = shift ;
+
+    return &Error("Can't check not specified table")
+        unless (defined($name) and $name);
+
+    return &Error("Not connected to DB") unless (&a2p_db_connected);
+
+    return $TABLES{$name} if (defined($TABLES{$name}) and $TABLES{$name});
+
+    #&Debug("Checking table '$name' exitence");
+    if (!defined($TABLES{$name})
+    and $DBH->do("SHOW TABLES LIKE '$A2PDB_TABLE_PREFIX$name'")>0) {
+        $TABLES{$name} = 1 ;
+
+    } else {
+        &Debug("Table '$name' seems not exists: ".$DBH->errstr());
+        $TABLES{$name} = 0 ;
+
+        # Only one recursive call is possible
+        unless (@_) {
+            my $statement ;
+            my $table_name = defined($sub) ? &$sub($name) : $name ;
+
+            if (defined($CREATE_TABLE{$table_name})) {
+                $statement = $CREATE_TABLE{$table_name} ;
+
+            } else {
+                return &Error("Table '$table_name' creation not supported");
+            }
+
+            # Update to create table if not exists
+            $statement =~
+                s/CREATE\s+TABLE\s+$table_name/CREATE TABLE IF NOT EXISTS $A2PDB_TABLE_PREFIX$name/mi ;
+
+            # Also update indexes names when a prefix is set
+            $statement =~ s/^(\s*)INDEX\s+/INDEX $A2PDB_TABLE_PREFIX/mig
+                if ($A2PDB_TABLE_PREFIX);
+
+            &Debug("Try to create table with $statement") if __A2P_DB_DEBUG__ ;
+
+            $DBH->do($statement)
+                or return &Error("Can't create '$name' table: ".$DBH->errstr());
+
+            # Force commit on creation
+            $DBH->commit()
+                 or return &Error("Bad commit: ".$DBH->errstr());
+
+            my $check = "SHOW TABLES LIKE '$A2PDB_TABLE_PREFIX$name'" ;
+            $TABLES{$name} = ($DBH->do($check) > 0) ?
+                (&Debug("Table '$name' available"),1)
+                :
+                &Error("Table '$name' not created: ".$DBH->errstr());
+        }
+    }
+
+    return $TABLES{$name} ;
+}
+
+my $cache_timer = [ &gettimeofday() ];
+
+sub check_commit {
+    # Add a call to this sub in a loop to force commit after max_timer seconds
+
+    # Check cache each minute to definitively remove value older than 10 minutes
+    if ( &tv_interval($cache_timer) > 60
+    and defined($CACHE->{'__expiration_list'})
+    and @{$CACHE->{'__expiration_list'}}) {
+        my @temp = () ;
+
+        # Don't pass more than one second to purge the cache
+        my $timeout_timer = [ &gettimeofday() ];
+        while ( @{$CACHE->{'__expiration_list'}}
+        and &tv_interval($timeout_timer) < 1 ) {
+            my $oldwhat = shift @{$CACHE->{'__expiration_list'}} ;
+            my $value_ref = &recursive_ref($CACHE,@{$oldwhat});
+            if (ref($value_ref) ne 'ARRAY') {
+                &Warn("(@{$oldwhat}) gives no valid value from cache, " .
+                    "cache may be corrupted");
+                next ;
+
+            } elsif (&tv_interval($value_ref->[1])<600) {
+                # Keep too young values
+                push @temp, $oldwhat ;
+                next ;
+            }
+
+            # Here this is a value to remove from cache
+            while (@{$oldwhat}) {
+                my $key = pop @{$oldwhat} ;
+                my $ref = &recursive_ref($CACHE,@{$oldwhat})
+                    or last;
+                if (ref($ref) =~ /^HASH/) {
+                    delete $ref->{$key} ;
+                    # Don't delete hash ref if other value are cached here
+                    last if (keys(%{$ref}));
+                }
+            }
+        }
+
+        # Update expiration list with not expired kept list
+        if (@{$CACHE->{'__expiration_list'}}) {
+            push @{$CACHE->{'__expiration_list'}}, @temp ;
+
+        } else {
+            $CACHE->{'__expiration_list'} = \@temp ;
+        }
+
+        # Reset cache timer
+        $cache_timer = [ &gettimeofday() ];
+    }
+
+    return 1
+        unless ( $actual_commit and &tv_interval($commit_timer) > $max_timer );
+
+    # Check to adapt futur timer check, reduce max_timer, it will be added
+    # with 1 second after the commit call, so it will be corrected just after
+    my $reduce_max_timer = (@commit_timers < $STATS_COMMIT_SKIP>>1) ;
+    # Only do a correction if not enough commit has occured, here not enought
+    # means commits rate is lower than half of expected rate
+
+    # Keep only timers lower than current max_timer interval
+    while (@commit_timers and &tv_interval($commit_timers[0]) > $max_timer ) {
+        shift @commit_timers ;
+    }
+
+    # Reset timer for next commit check
+    $commit_timer = [ &gettimeofday() ] ;
+
+    $actual_commit = $STATS_COMMIT_SKIP ;
+    &commit(); # max_timer is added with one second if lower than 10
+
+    # Then apply correction (so will be -2 first time, than -1)
+    $max_timer -= ($max_timer>2 and $reduce_max_timer) ? 2 : 0 ;
+}
+
+sub commit {
+    # Do nothing if AutoCommit if activated
+    return defined($actual_commit = 0)
+        if (defined($DBH->{AutoCommit}) and $DBH->{AutoCommit});
+
+    # Keep call time
+    push @commit_timers, [ &gettimeofday() ] ;
+
+    return 1
+        unless ( ++ $actual_commit > $STATS_COMMIT_SKIP );
+
+    # Update max_timer if still not to 10 seconds
+    $max_timer ++ if ( $max_timer < 10 );
+
+    $actual_commit = 0 ;
+    $DBH->commit()
+        or return &Error("Bad commit: ".$DBH->errstr());
+
+    1 ;
+}
+
+sub get_table_hash {
+    my $table = shift ;
+    my $key   = shift ;
+
+    my $internal_stat_key = 'DB-GET-TABLE-HASH-' . uc($table) ;
+    &TIMESTAT($internal_stat_key); &UPSTAT($internal_stat_key);
+
+    return &Error("Can't get not specified table")
+        unless (defined($table) and $table);
+
+    return &Error("Can't get hash with unspecified key")
+        unless (defined($key) and $key);
+
+    unless (exists($TABLES{$table})) {
+        &Debug("Force checking '$table' table is available");
+        &CheckTable($table);
+    }
+
+    return &Error("Can't get hash for unknown table '$table'")
+        unless (defined($TABLES{$table}) and $TABLES{$table});
+
+    my $sth = $DBH->prepare_cached("SELECT * FROM $A2PDB_TABLE_PREFIX$table")
+        or return &Error("Can't prepare request to get '$table' table: " .
+            $DBH->errstr());
+
+    $sth->execute()
+        or return &Error("Can't get '$table' table: ".$DBH->errstr());
+
+    my $hashref ;
+    # Check if we can call fetchall_hashref with an ARRAY ref
+    if ( ref($key) =~ /^ARRAY/ and $DBI::VERSION < 1.48 ) {
+        # Simulate the same API than later DBI version
+        my $arrayref = $sth->fetchall_arrayref({})
+            or return &Error("Can't get '$table' table as array of hash: " .
+            $DBH->errstr());
+
+        $hashref = {} ;
+        while (@{$arrayref}) {
+            my $row = shift @{$arrayref} ;
+
+            my $newref = $hashref ;
+            my @keys = @{$key} ;
+            while (@keys) {
+                my $nextkey = shift @keys ;
+                my $this = $row->{$nextkey} ;
+                # Finally affect the row to the last ref
+                $newref->{$this} = @keys ? {} : $row
+                    unless (exists($newref->{$this}));
+                $newref = $newref->{$this} ;
+            }
+        }
+
+    } else {
+        $hashref = $sth->fetchall_hashref($key)
+            or return &Error("Can't get '$table' table as hash: " .
+            $DBH->errstr());
+    }
+
+    $sth->finish ;
+
+    &MAXSTAT($internal_stat_key.'-KEYCOUNT',scalar(keys(%{$hashref})));
+    &TIMESTAT($internal_stat_key);
+
+    return $hashref ;
+}
+
+
+################################################################################
+### Statistics API
+################################################################################
+my $Statistics_ready = undef ;
+sub a2p_db_statistics_ready {
+    return $Statistics_ready if (defined($Statistics_ready));
+
+    # Check needed tables are availables
+    foreach my $table (keys(%CREATE_TABLE)) {
+        next if ($table =~ /jobs/);
+        &CheckTable($table)
+            or return $Statistics_ready = 0 ;
+    }
+
+    return $Statistics_ready = 1 ;
+}
+
+sub CheckJobsTables {
+    my $date = shift || '' ;
+    ( $MONTH ) = $date =~ /^(\d{6})/ ;
+
+    &CheckTable('afpjobs_'.$MONTH,\&job_tablename_check)
+        or return &Error("No table available for afpjobs_$MONTH month");
+
+    &CheckTable('jobs_'.$MONTH,\&job_tablename_check)
+        or return &Error("No table available for jobs_$MONTH month");
+}
+
+sub job_tablename_check {
+    my $name = shift || '' ;
+    &Debug("Checking table name '$name'");
+    return $name =~ /^(\w*jobs_)/ ? $1 . 'YYYYMM' : $name ;
+}
+
+sub stats_set_service {
+    $service = shift || 'unknown' ;
+}
+
+sub mysql_insert_id {
+    my $select = $DBH->prepare_cached(qq{
+        SELECT LAST_INSERT_ID()
+    });
+
+    $select->execute()
+        or return &Error("Can't get last inserted id: ".$DBH->errstr());
+
+    my ( $last_id ) = $select->fetchrow_array ;
+    $select->finish ;
+
+    return $last_id ? $last_id : &Error("Can't get valid last inserted id") ;
+}
+
+sub recursive_ref {
+    my $ref = shift ;
+    return $ref unless @_ ;
+    my $key = shift ;
+    unless (ref($ref) =~ /^HASH/i and exists($ref->{$key})) {
+        &Debug("No value referenced as $ref -> $key") if __A2P_DB_DEBUG__ ;
+        return 0 ;
+    }
+    return &recursive_ref( $ref->{$key}, @_ );
+}
+
+sub cached {
+    my $what  = shift || [] ;
+    my $value = undef ;
+
+    return $value unless ( @{$what} > 1 ) ;
+
+    if (@_) {
+        my $which_list = ($what->[0]).'__list' ;
+        $value = shift ;
+
+        # Set cache for a value
+        push @{$CACHE->{$which_list}}, [ @{$what} ] ;
+
+        # Push old values in a list with expiration checked later
+        if (@{$CACHE->{$which_list}} > $MAX_CACHED_DB) {
+            my $oldwhat = shift @{$CACHE->{$which_list}} ;
+            push @{$CACHE->{'__expiration_list'}}, $oldwhat ;
+        }
+
+        # Prepare hash tree cache
+        &Debug("Caching $value as ".join('=>',@{$what})) if __A2P_DB_DEBUG__ ;
+        my $whatref = $CACHE ;
+        my $whatkey = shift @{$what} ;
+        while (@{$what}) {
+            unless (defined($whatref->{$whatkey})) {
+                $whatref->{$whatkey} = {} ;
+                &Debug("Cache hash $whatref -> $whatkey initialized")
+                    if __A2P_DB_DEBUG__ ;
+            }
+            $whatref = $whatref->{$whatkey} ;
+            $whatkey = shift @{$what} ;
+        }
+
+        # Set cache and return now to not update cache statistics
+        $whatref->{$whatkey} = [ $value , [ &gettimeofday() ]];
+        &Debug("$value cache as $whatref -> $whatkey") if __A2P_DB_DEBUG__ ;
+
+    } elsif (defined($CACHE)) {
+        my $value_ref = &recursive_ref($CACHE,@{$what});
+        if ($value_ref and ref($value_ref) =~ /^ARRAY/) {
+            $value = $value_ref->[0] ;
+            # Update value timer
+            $value_ref->[1] = [ &gettimeofday() ] ;
+        }
+
+        # Update internal hit/miss cache statistics
+        defined($value) ?
+            &UPSTAT('CACHE-HIT--'.($what->[0]))
+            :
+            &UPSTAT('CACHE-MISS-'.($what->[0])) ;
+    }
+
+    return $value ;
+}
+
+sub set_afpjid_from {
+    my $JobID = shift ;
+
+    return &Error("No JobID provided") unless $JobID ;
+
+    &Warn("Trying to set afpjid for $JobID and $MONTH without serviceid set")
+        unless ($serviceid);
+
+    my $cache_key_list = [ 'afpjid', $MONTH, $serviceid, $JobID ] ;
+
+    # Return cached value
+    my $cached = &cached($cache_key_list) ;
+    return $afpjid = $cached if (defined($cached) and $cached);
+
+    my $select = $DBH->prepare_cached(qq{
+        SELECT afpjid FROM ${A2PDB_TABLE_PREFIX}afpjobs_$MONTH
+            WHERE JobID=? and serviceid=?
+        });
+
+    $select->execute($JobID,$serviceid)
+        or return &Error("Can't select afpjid from '$JobID' JobID " .
+            "in afpjobs table: " . $DBH->errstr());
+
+    ( $afpjid ) = $select->fetchrow_array ;
+    $select->finish ;
+
+    unless (defined($afpjid) and $afpjid) {
+        # Insert a new row for this job
+        my $insert = $DBH->prepare_cached(qq{
+            INSERT INTO ${A2PDB_TABLE_PREFIX}afpjobs_$MONTH
+            (JobID,serviceid,Date,DayTime,State,Errors,NBJobs,Chrono,Counted)
+            VALUES(?,?,?,?,'  ',0,0,0,0)
+        });
+
+        $insert->execute($JobID,$serviceid,$JOB->[0],$JOB->[1])
+            or return &Error("Can't insert '$JobID' JobID in afpjobs table: " .
+                $DBH->errstr());
+
+        $afpjid = &mysql_insert_id() if (&commit());
+    }
+
+    return $afpjid = &Error("Can't get a valid afpjid")
+        unless (defined($afpjid) and $afpjid);
+
+    &Debug("Set afpjid to $afpjid") if (__A2P_DB_DEBUG__ and defined($afpjid));
+
+    return &cached($cache_key_list, $afpjid);
+}
+
+sub set_countid {
+
+    return &Error("Can't set new counter without valid serviceid")
+        unless (defined($serviceid) and $serviceid);
+
+    my $cache_key_list = [ 'countid', $MONTH, $serviceid ] ;
+
+    # Return cached value
+    my $cached = &cached($cache_key_list) ;
+    return $countid = $cached if (defined($cached) and $cached);
+
+    # Search for countid
+    my $select = $DBH->prepare_cached(qq{
+        SELECT countid FROM ${A2PDB_TABLE_PREFIX}Count
+        WHERE serviceid=? and YearMonth=?
+        });
+
+    $select->execute($serviceid,$MONTH)
+        or return &Error("Can't select countid in Count table: " .
+            $DBH->errstr());
+
+    ( $countid ) = $select->fetchrow_array ;
+    $select->finish ;
+
+    unless ((defined($countid) and $countid) or @_) {
+        # Insert a new row for this service and month
+        my $insert = $DBH->prepare_cached(qq{
+            INSERT INTO ${A2PDB_TABLE_PREFIX}Count
+                (serviceid,YearMonth,afpjobs_nb,afpjobs_tps,afpjobs_err,
+                jobs_nb,jobs_err,pages_nb)
+                VALUES(?,?,0,0,0,0,0,0)
+        });
+
+        $insert->execute($serviceid,$MONTH)
+            or return &Error("Can't insert counter in Count table: " .
+                $DBH->errstr());
+
+        $countid = &mysql_insert_id() if (&commit());
+    }
+
+    return $countid = &Error("Can't get a valid countid")
+        unless (defined($countid) and $countid);
+
+    &Debug("Set countid to '$countid'") if __A2P_DB_DEBUG__ ;
+    return &cached($cache_key_list, $countid) ;
+}
+
+sub set_ddid {
+
+    my $cache_key_list = [ 'ddid', $destid, $docid ] ;
+
+    # Return cached value
+    my $cached = &cached($cache_key_list) ;
+    return $ddid = $cached if (defined($cached) and $cached);
+
+    # Search for ddid
+    my $select = $DBH->prepare_cached(qq{
+        SELECT ddid FROM ${A2PDB_TABLE_PREFIX}DocDestCount
+        WHERE destid=? AND docid=?
+        });
+
+    $select->execute($destid,$docid)
+        or return &Error("Can't select ddid in DocDestCount table: " .
+            $DBH->errstr());
+
+    ( $ddid ) = $select->fetchrow_array ;
+    $select->finish ;
+
+    unless (defined($ddid) and $ddid) {
+        # Insert a new row for this document
+        my $insert = $DBH->prepare_cached(qq{
+            INSERT INTO ${A2PDB_TABLE_PREFIX}DocDestCount
+                (destid,docid,FirstTime,LastTime,Count)
+                VALUES(?,?,?,?,0)
+        });
+
+        $insert->execute($destid,$docid,$JOB->[0],$JOB->[0])
+            or return &Error("Can't insert docdest counter " .
+                "in DocDestCount table: " . $DBH->errstr());
+
+        $ddid = &mysql_insert_id() if (&commit());
+    }
+
+    return $ddid = &Error("Can't get a valid ddid")
+        unless (defined($ddid) and $ddid);
+
+    &Debug("Set ddid to '$ddid'") if __A2P_DB_DEBUG__ ;
+    return &cached($cache_key_list, $ddid) ;
+}
+
+sub set_destid_from {
+    my $DestID = shift || '(none)' ;
+    $DestID = '(NULL)' if ($DestID =~ /^NULL$/i);
+    $DestID = '(none)' if ($DestID =~ /^\s*$/);
+
+    my $cache_key_list = [ 'destid', $DestID ] ;
+
+    # Return cached value
+    my $cached = &cached($cache_key_list) ;
+    return $destid = $cached if (defined($cached) and $cached);
+
+    # Get serviceid from table or insert a new one
+    my $destinations = &get_table_hash('Destinations','DestIdName');
+
+    return &Error("Can't get Destinations hash")
+        unless (defined($destinations) and $destinations);
+
+    $destid = $destinations->{$DestID}->{'destid'}
+        if (defined($destinations->{$DestID}));
+
+    unless (defined($destid) and $destid) {
+        # Here we need to insert a new service and get the new serviceid
+        &Debug("Inserting new DestID '$DestID' after last '$destid' one")
+            if __A2P_DB_DEBUG__ ;
+
+        my $insert = $DBH->prepare_cached(qq{
+            INSERT INTO ${A2PDB_TABLE_PREFIX}Destinations
+            (DestIdName, FirstTime, LastTime, Count)
+            VALUES(?,?,?,0)
+            });
+
+        $insert->execute($DestID,$JOB->[0],$JOB->[0])
+            or return &Error("Can't insert '$DestID,$JOB->[0],$JOB->[0],0' " .
+                "in Destinations table: ".$DBH->errstr());
+
+        # Get last inserted id
+        $destid = &mysql_insert_id() if (&commit());
+    }
+
+    return $destid = &Error("Can't get a valid destid")
+        unless (defined($destid) and $destid);
+
+    &Debug("Last inserted destination has '$destid' id") if __A2P_DB_DEBUG__ ;
+    return &cached($cache_key_list, $destid );
+}
+
+sub set_docid {
+    # Set cache list avoiding empty keys
+    my $cache_key_list = [
+        'docid', @{$JOB}[5..7], map { $_.'_' } @{$JOB}[8..10]
+        ] ;
+
+    # Return cached value
+    my $cached = &cached($cache_key_list) ;
+    return $docid = $cached if (defined($cached) and $cached);
+
+    # Search for docid
+    my $select = $DBH->prepare_cached(qq{
+        SELECT docid FROM ${A2PDB_TABLE_PREFIX}Documents
+        WHERE PageDef=? AND FormDef=? AND DocName=? AND PageFormats=?
+            AND CopyGroups=? AND Logos=?
+        });
+
+    $select->execute(@{$JOB}[5..10])
+        or return &Error("Can't select docid in Documents table: " .
+            $DBH->errstr());
+
+    ( $docid ) = $select->fetchrow_array ;
+    $select->finish ;
+
+    unless (defined($docid) and $docid) {
+        # Insert a new row for this document
+        my $insert = $DBH->prepare_cached(qq{
+            INSERT INTO ${A2PDB_TABLE_PREFIX}Documents
+            (PageDef,FormDef,DocName,PageFormats,CopyGroups,
+            Logos,FirstTime,LastTime,Count)
+            VALUES(?,?,?,?,?,?,?,?,0)
+        });
+
+        $insert->execute(@{$JOB}[5..10],$JOB->[0],$JOB->[0])
+            or return &Error("Can't insert document in Documents table: " .
+                $DBH->errstr());
+
+        # Get last inserted id
+        $docid = &mysql_insert_id() if (&commit());
+    }
+
+    return $docid = &Error("Can't get a valid docid")
+        unless (defined($docid) and $docid);
+
+    &Debug("Set docid to '$docid'") if __A2P_DB_DEBUG__ ;
+    return &cached($cache_key_list, $docid);
+}
+
+sub set_jid_from {
+    my $Number = shift || 0 ;
+
+    my $cache_key_list = [ 'jid', $MONTH, $afpjid, $Number ] ;
+
+    # Return cached value
+    my $cached = &cached($cache_key_list) ;
+    return $jid = $cached if (defined($cached) and $cached);
+
+    my $select = $DBH->prepare_cached(qq{
+        SELECT jid FROM ${A2PDB_TABLE_PREFIX}jobs_$MONTH
+        WHERE afpjid=? and Number=?
+        });
+
+    $select->execute($afpjid,$Number)
+        or return &Error("Can't select jid from '$Number' Number " .
+            " in jobs table: " . $DBH->errstr());
+
+    ( $jid ) = $select->fetchrow_array ;
+    $select->finish ;
+
+    unless (defined($jid) and $jid) {
+        # Insert a new row for this job
+        my $insert = $DBH->prepare_cached(qq{
+            INSERT INTO ${A2PDB_TABLE_PREFIX}jobs_$MONTH
+                (afpjid,Number,destid,docid,
+                NbPages,State,Timing,Chrono,Kind,Errors,Counted,Jobname)
+                VALUES(?,?,?,0,0,'  ',0,0,' ',0,0,'')
+        });
+
+        $insert->execute($afpjid,$Number,$destid)
+            or return &Error("Can't insert job '$Number' for '$afpjid' afpjob "
+                . " in jobs table: " . $DBH->errstr());
+
+        $jid = &mysql_insert_id() if (&commit());
+    }
+
+    return $jid = &Error("Can't get a valid jid")
+        unless (defined($jid) and $jid);
+
+    &Debug("Set jid to '$jid'") if (__A2P_DB_DEBUG__);
+    return &cached($cache_key_list, $jid);
+}
+
+sub set_serviceid_from {
+    my $LockID = shift || 'unknown' ;
+
+    my $cache_key_list = [ 'serviceid', $Server, $service, $LockID ] ;
+
+    # Return cached value
+    my $cached = &cached($cache_key_list) ;
+    return $serviceid = $cached if (defined($cached) and $cached);
+
+    &Debug("Services table not cached") if __A2P_DB_DEBUG__ ;
+
+    # Get serviceid from table or insert a new one
+    my $Services = &get_table_hash('Services','serviceid')
+        or return &Error("Can't get Services hash");
+
+    # Parse DB table returned as hash
+    my $found = 0 ;
+    foreach my $id (keys(%{$Services})) {
+        next unless ($Services->{$id}->{Name}   =~ /^$service$/ );
+        next unless ($Services->{$id}->{Server} =~ /^$Server$/i );
+        next unless ($Services->{$id}->{LockID} =~ /^$LockID$/  );
+        &Debug("Extracted serviceid '$id' from Services table")
+            if __A2P_DB_DEBUG__ ;
+        $found ++ ;
+        $serviceid = $id ;
+        last ;
+    }
+
+    unless ($found and $serviceid) {
+        # Here we need to insert a new service and get the new serviceid
+        &Debug("Inserting new service '$service,$Server,$LockID' after last "
+            . "'$serviceid' one") if __A2P_DB_DEBUG__ ;
+
+        my $insert = $DBH->prepare_cached(qq{
+            INSERT INTO ${A2PDB_TABLE_PREFIX}Services
+            (Name, Server, LockID)
+            VALUES(?,?,?)
+            });
+
+        $insert->execute($service,$Server,$LockID)
+            or return &Error("Can't insert '$service,$Server,$LockID' " .
+                "in Services table: " . $DBH->errstr());
+
+        # Get last inserted id
+        $serviceid = &mysql_insert_id() if (&commit());
+
+        &Debug("Last inserted service has $serviceid id") if __A2P_DB_DEBUG__ ;
+    }
+
+    return $serviceid = &Error("Can't get a valid serviceid")
+        unless (defined($serviceid) and $serviceid);
+
+    &Debug("Keeping $serviceid id in cache") if __A2P_DB_DEBUG__ ;
+    $cached = &cached($cache_key_list, $serviceid);
+    &Debug("$cached value kept in cache") if __A2P_DB_DEBUG__ ;
+    return $cached ;
+}
+
+sub stats_converter {
+    $JOB = shift ;
+
+    return &Error("Converter line: Not connected to DB")
+        unless (&a2p_db_connected());
+
+    # Reset global value for that line
+    ( $afpjid , $jid , $countid, $serviceid, $destid ) = ( 0, 0, 0, 0, 0 );
+    ( $docid , $ddid ) = ( 0, 0 );
+
+    # 1. Check tables for job are availables
+    &CheckJobsTables($JOB->[0])
+        or return &Error("Converter line: " .
+            "Tables not available for $JOB->[0] date");
+
+    # 2. Update serviceid as we known LOCKID
+    &set_serviceid_from($JOB->[13])
+        or return &Error("Converter line: Can't find DB serviceid");
+
+    # 3. Set countid
+    &set_countid()
+        or return &Error("Converter line: Can't find DB countid");
+
+    # 4. Set afpjid
+    &set_afpjid_from($JOB->[2])
+        or return &Error("Converter line: Can't find DB afpjid");
+
+    # 7. Check if it has been counted
+    my $select = $DBH->prepare_cached(qq{
+        SELECT Counted FROM ${A2PDB_TABLE_PREFIX}afpjobs_$MONTH
+        WHERE afpjid=?
+        });
+
+    $select->execute($afpjid)
+        or return &Error("Can't select job row from '$jid' jid in jobs table: "
+            . $DBH->errstr());
+
+    my ( $afpjid_counted ) = $select->fetchrow_array ;
+    $select->finish ;
+
+    # 5. Set destid
+    &set_destid_from( $JOB->[4] )
+        or return &Error("Converter line: Can't find DB destid");
+
+    # 6. Set jid
+    my ( $number ) = $JOB->[3] =~ /^.*-AFP(\d+)$/ ;
+    &set_jid_from( $number )
+        or return &Error("Converter line: Can't find DB jid");
+
+    # 7. Check if it has been counted
+    $select = $DBH->prepare_cached(qq{
+        SELECT Counted FROM ${A2PDB_TABLE_PREFIX}jobs_$MONTH
+        WHERE jid=?
+        });
+
+    $select->execute($jid)
+        or return &Error("Can't select job row from '$jid' jid in jobs table: "
+            . $DBH->errstr());
+
+    my ( $counted ) = $select->fetchrow_array ;
+    $select->finish ;
+
+    # 8. Still return if it still has been counted
+    return $counted if ($counted & 1);
+
+    # 9. Set docid
+    &set_docid()
+        or return &Error("Converter line: Can't find DB docid");
+
+    # 10. Set ddid
+    &set_ddid()
+        or return &Error("Converter line: Can't find DB ddid");
+
+    # 11. Set session variable
+    my $settime = $DBH->prepare_cached(q{
+        SET @THISTIME = ?, @THISHOUR = ?
+        });
+    $settime->execute($JOB->[0],$JOB->[1])
+        or return &Error("Converter line: " .
+            "Can't set THISTIME to '$JOB->[0]': " .
+            $DBH->errstr());
+
+    # 12. Update row in jobs table
+    my $update = $DBH->prepare_cached(qq{
+        UPDATE ${A2PDB_TABLE_PREFIX}jobs_$MONTH
+        SET docid=?, Jobname=?, NbPages=?, Kind=?, Counted=Counted | 1
+        WHERE jid=?
+        });
+
+    $update->execute($docid,$JOB->[3],$JOB->[11],$JOB->[12],$jid)
+        or return &Error("Converter line: " .
+            "Can't update row '$jid' in jobs_$MONTH table: " .
+            $DBH->errstr());
+
+    # 13. At the same time, update jobs_nb and pages_nb
+    if ($JOB->[11] =~ /^\d+$/) {
+        $update = $DBH->prepare_cached(qq{
+            UPDATE ${A2PDB_TABLE_PREFIX}Count
+            SET afpjobs_nb=afpjobs_nb+?, jobs_nb=jobs_nb+1,
+                pages_nb=pages_nb+$JOB->[11]
+            WHERE countid=?
+            });
+
+        $update->execute( $afpjid_counted ? 0 : 1 , $countid )
+            or return &Error("Converter line: " .
+                "Can't update $countid row in Count table: " .
+                $DBH->errstr());
+    }
+
+    # 14. Update also Destination counter
+    $update = $DBH->prepare_cached(qq{
+        UPDATE ${A2PDB_TABLE_PREFIX}Destinations
+        SET Count=Count+1,
+            FirstTime=IF(FirstTime<=\@THISTIME,FirstTime,\@THISTIME),
+            LastTime=IF(LastTime>=\@THISTIME,LastTime,\@THISTIME)
+        WHERE destid=? ;
+        });
+
+    $update->execute($destid)
+        or return &Error("Converter line: " .
+            "Can't update $destid row in Destinations table: " .
+            $DBH->errstr());
+
+    # 15. Update also Document counter
+    $update = $DBH->prepare_cached(qq{
+        UPDATE ${A2PDB_TABLE_PREFIX}Documents
+        SET Count=Count+1,
+            FirstTime=IF(FirstTime<=\@THISTIME,FirstTime,\@THISTIME),
+            LastTime=IF(LastTime>=\@THISTIME,LastTime,\@THISTIME)
+        WHERE docid=?
+        });
+
+    $update->execute($docid)
+        or return &Error("Converter line: " .
+            "Can't update $docid row in Documents table: " .
+            $DBH->errstr());
+
+    # 16. Update also DocDest counter
+    $update = $DBH->prepare_cached(qq{
+        UPDATE ${A2PDB_TABLE_PREFIX}DocDestCount
+        SET Count=Count+1,
+            FirstTime=IF(FirstTime<=\@THISTIME,FirstTime,\@THISTIME),
+            LastTime=IF(LastTime>=\@THISTIME,LastTime,\@THISTIME)
+        WHERE ddid=?
+        });
+
+    $update->execute($ddid)
+        or return &Error("Converter line: " .
+            "Can't update $ddid row in DocDestCount table: " .
+            $DBH->errstr());
+
+    # 17. Update also NBJobs counter in afpjobs
+    $update = $DBH->prepare_cached(qq{
+        UPDATE ${A2PDB_TABLE_PREFIX}afpjobs_$MONTH
+        SET NBJobs=NBJobs+1, Counted=Counted | 1,
+            Date=IF(Date<=\@THISTIME,Date,\@THISTIME),
+            DayTime=IF(DayTime<=\@THISHOUR,DayTime,\@THISHOUR)
+        WHERE afpjid=?
+        });
+
+    $update->execute($afpjid)
+        or return &Error("Converter line: " .
+            "Can't update $afpjid row in afpjobs_$MONTH table: " .
+            $DBH->errstr());
+
+    # Finally. Commit changes and return commit success
+    return &commit() ;
+}
+
+sub stats_jobmanager {
+    $JOB = shift ;
+
+    return &Error("JobManager line: Not connected to DB")
+        unless (&a2p_db_connected());
+
+    ( $afpjid , $jid , $countid, $serviceid, $destid ) = ( 0, 0, 0, 0, 0 );
+
+    # 1. Check tables for job are availables
+    &CheckJobsTables($JOB->[0])
+        or return &Error("JobManager line: Tables not available for " .
+             $JOB->[0] . " date");
+
+    # 2. Update serviceid as we known LOCKID
+    &set_serviceid_from($JOB->[8])
+        or return &Error("JobManager line: Can't find $JOB->[8] DB serviceid");
+
+    # 3. Set countid
+    &set_countid()
+        or return &Error("JobManager line: Can't find DB countid");
+
+    if ($JOB->[4]) {
+        # 4. Set afpjid as extrated from jid
+        my ( $JobID ) = $JOB->[2] =~ /^(.*)-\d+$/ ;
+        &set_afpjid_from( $JobID )
+            or return &Error("JobManager line: Can't find DB afpjid for job");
+
+        # 5. Set destid
+        &set_destid_from( $JOB->[3] )
+            or return &Error("JobManager line: Can't find DB destid");
+
+        # 6. Set jid
+        my ( $number ) = $JOB->[2] =~ /^.*-(\d+)$/ ;
+        &set_jid_from( $number )
+            or return &Error("JobManager line: Can't find DB jid");
+
+        # 7. Check if it has been counted
+        my $select = $DBH->prepare_cached(qq{
+            SELECT Counted FROM ${A2PDB_TABLE_PREFIX}jobs_$MONTH
+            WHERE jid=?
+            });
+
+        $select->execute($jid)
+            or return &Error("JobManager line: " .
+                "Can't check if counted in jobs table: " .
+                $DBH->errstr());
+
+        my ( $counted ) = $select->fetchrow_array ;
+        $select->finish ;
+
+        # 8. Still return if it still has been counted
+        return $counted if ($counted & 2);
+
+        # 9. Update row in jobs table
+        my $update = $DBH->prepare_cached(qq{
+            UPDATE ${A2PDB_TABLE_PREFIX}jobs_$MONTH
+            SET State=?, Errors=?, Timing=?, Chrono=?, Counted=Counted | 2
+            WHERE jid=?
+            });
+
+        my ( $chrono ) = $JOB->[7] =~ /^([0-9.]+)/ ;
+        my ( $timing ) = $JOB->[9] =~ /^([0-9.]+)/ ;
+        $update->execute($JOB->[4],$JOB->[6],$timing,$chrono,$jid)
+            or return &Error("JobManager line: " .
+                "Can't update row '$jid' in jobs_$MONTH table: " .
+                $DBH->errstr());
+
+        # 10. At the same time, update jobs_err when some found
+        if ($JOB->[6] =~ /^\d+$/ and $JOB->[6]) {
+            $update = $DBH->prepare_cached(qq{
+                UPDATE ${A2PDB_TABLE_PREFIX}Count
+                SET jobs_err=jobs_err+$JOB->[6]
+                WHERE countid=?
+                });
+
+            $update->execute($countid)
+                or return &Error("JobManager line: " .
+                    "Can't update $countid row in Count table: " .
+                    $DBH->errstr());
+        }
+
+    } else {
+        # 4. Set afpjid
+        &set_afpjid_from($JOB->[2])
+            or return &Error("JobManager line: Can't find DB afpjid of afpjob");
+
+        # 5. Check if it has been counted
+        my $select = $DBH->prepare_cached(qq{
+            SELECT Counted FROM ${A2PDB_TABLE_PREFIX}afpjobs_$MONTH
+            WHERE afpjid=?
+            });
+
+        $select->execute($afpjid)
+            or return &Error("JobManager line: " .
+                "Can't check if counted in afpjobs table: " .
+                $DBH->errstr());
+
+        my ( $counted ) = $select->fetchrow_array ;
+        $select->finish ;
+
+        # 6. Still return if it still has been counted
+        return $counted if ($counted & 2);
+
+        # 7. Update row in afpjobs table
+        my $update = $DBH->prepare_cached(qq{
+            UPDATE ${A2PDB_TABLE_PREFIX}afpjobs_$MONTH
+            SET State=?, Errors=?, Chrono=?, Counted=Counted | 2
+            WHERE afpjid=?
+            });
+
+        my ( $chrono ) = $JOB->[7] =~ /^([0-9.]+)/ ;
+        $update->execute($JOB->[5],$JOB->[6],$chrono,$afpjid)
+            or return &Error("JobManager line: " .
+                "Can't update row '$afpjid' in afpjobs_$MONTH table: " .
+                $DBH->errstr());
+
+        # 8. At the same time, update afpjobs_nb and afpjobs_err Count
+        if ($JOB->[6] =~ /^\d+$/ and $JOB->[6]) {
+            $update = $DBH->prepare_cached(qq{
+                UPDATE ${A2PDB_TABLE_PREFIX}Count
+                SET afpjobs_nb=afpjobs_nb+?, afpjobs_tps=afpjobs_tps+?,
+                    afpjobs_err=afpjobs_err+$JOB->[6]
+                WHERE countid=?
+                });
+
+        } else {
+            $update = $DBH->prepare_cached(qq{
+                UPDATE ${A2PDB_TABLE_PREFIX}Count
+                SET afpjobs_nb=afpjobs_nb+?, afpjobs_tps=afpjobs_tps+?
+                WHERE countid=?
+                });
+        }
+
+        $update->execute($counted ? 0 : 1 , $chrono/1000, $countid)
+            or return &Error("JobManager line: " .
+                "Can't update $countid row in Count table: " .
+                $DBH->errstr());
+    }
+
+    # Finally. Commit changes and return commit success
+    return &commit() ;
+}
+
+
+################################################################################
+### JobStatus API
+################################################################################
+my $service_list = 0 ;
+my $service_list_timer = [] ;
+
+sub CheckJobsStatusTables {
+    &CheckTable('Services') or
+        return &Error("No 'Services' table available for managing Jobs status");
+
+    return &CheckTable('jobs_status') ||
+        &Error("No 'jobs_status' table available for Jobs status");
+}
+
+sub CheckJobsQueueTable {
+    return &CheckTable('jobs_queue') ||
+        &Error("No 'jobs_queue' table available for Jobs management");
+}
+
+sub get_serviceid_info {
+    # API to retrieve the services sid of local services
+    &UPSTAT('JOBSTATUS-DB-GET-SERVICES-TRY');
+
+    # Update service list ref only one time per minute
+    if ($service_list and @{$service_list_timer} and not @_) {
+        return $service_list
+            unless (&tv_interval($service_list_timer) > 60);
+
+        &UPSTAT('JOBSTATUS-DB-GET-SERVICES-RECHECK');
+    }
+
+    # Get serviceid from table
+    my $Services = &get_table_hash('Services', [qw(Server Name LockID)] )
+        or return &Error("Can't get Services hash");
+
+    # Set timer
+    $service_list_timer = [ &gettimeofday() ] ;
+
+    # Get infos object if still not created
+    $service_list = new A2P::Infos() unless ($service_list) ;
+
+    if ( defined($_[0]) and $_[0] =~ /check all/i ) {
+        # Compute service id for each servers to cache them
+        foreach my $server ( keys(%{$Services}) ) {
+            my $hash = $Services->{$server} ;
+            &Debug("Caching $server sid");
+            $service_list = $service_list->get_serviceid_of( $hash );
+        }
+
+        # Return A2P::Infos object
+        return $service_list ;
+
+    } elsif ( ! exists($Services->{$Server}) or
+    ref($Services->{$Server}) !~ /^HASH/ ) {
+        # No entry in Services table will need to initialize it
+        return &Debug("No entry in table for '$Server' (@_)");
+    }
+
+    # Initialize/update A2P::Infos object with the ref for this server
+    # It returns 0 or itself as A2P::Infos object
+    return $service_list->get_serviceid_of( $Services->{$Server} );
+}
+
+sub _ms {
+    # Get current millisecond
+    my @time = &gettimeofday() ;
+    # If a parameter is defined, we want to add the seconds with it. It could be
+    # a negative number to get a timer to compare
+    $time[0] += shift if @_ ;
+    return int( $time[0] * 1000 + $time[1]/1000 );
+}
+
+sub job_status_update {
+    my $sid    = shift || 0 ;
+    my $lockid = shift ;
+    my $job    = shift ;
+
+    $serviceid = $service_list ?
+        $service_list->get_serviceid_of($lockid) : 0 ;
+
+    # If serviceid is not known we should try to re-initialize Infos object as
+    # the serviceid could just has been inserted in table
+    unless ($serviceid) {
+        &get_serviceid_info('check now'); # Just any arg to avoid timer check
+        $serviceid = $service_list->get_serviceid_of($lockid) || 0 ;
+    }
+
+    # Finally the serviceid not exists in table we should create a new one
+    unless ($serviceid) {
+        # Use default statistics APIs
+        my $sname = $service_list->get_servicename_of($lockid) || '' ;
+        return &Error("Can't handle service $lockid without configuration")
+            unless $sname ;
+        &stats_set_service($sname);
+        &set_serviceid_from($lockid);
+        unless ($serviceid) {
+            &get_serviceid_info('recheck now');
+            $serviceid = $service_list->get_serviceid_of($lockid) || 0 ;
+        }
+        return &Error("Can't set new serviceid for $lockid") unless $serviceid ;
+    }
+
+    # Prepare row to insert or update
+    my @row = map { defined($_) ? $_ : "" }
+        $serviceid, $job, @_[0..2], join("",@{$_[3]}), @_[4..10] ;
+
+    # Check if we can find the job in DB if it has no sid as it could has been
+    # run in on another computer and/or service. Check also if we are rechecking
+    # status after an a2p-status service restart
+    unless ( $sid =~ /^\d+$/ and $sid ) {
+        my $select = $DBH->prepare_cached(qq{
+            SELECT sid FROM ${A2PDB_TABLE_PREFIX}jobs_status
+            WHERE Jobname=? OR ( serviceid=? and JobID=? )
+            });
+
+        &UPSTAT('JOBSTATUS-DB-CHECKSID');
+
+        &Debug("Check if job $row[8] is still in DB");
+        $select->execute( $row[8], $serviceid, $job )
+            or return &Error("Can't check SID in jobs_status table: ".
+                $DBH->errstr());
+
+        my ( $thissid ) = $select->fetchrow_array ;
+        $select->finish ;
+        $sid = $thissid
+            if (defined($thissid) and $thissid and $thissid =~ /^\d+$/);
+    }
+
+    if ($sid) {
+        &TIMESTAT('JOBSTATUS-DB-UPDATE');
+        # Prepare to update a row if revision is not up to date
+        my $update = $DBH->prepare_cached(qq{
+            UPDATE ${A2PDB_TABLE_PREFIX}jobs_status
+            SET serviceid=?, JobID=?, Revision=?, Timer=?, Step=?, Steps=?,
+                Born=?, Date=?, JobName=?, CurrentStatus=?, NbJobs=?, DestIDs=?,
+                Infos=?
+            WHERE sid = ? AND (Revision < ? OR Born < ?)
+            });
+
+        &Debug("Update row $sid for $job rev$row[2] with '@row'");
+        &UPSTAT('JOBSTATUS-DB-UPDATE');
+
+        $update->execute(@row, $sid, $row[2], $row[6])
+            or $sid = &Error("Can't update $job db jobstatus: ".$DBH->errstr());
+
+        if ($sid and $DBH->commit()) {
+            &UPSTAT('JOBSTATUS-DB-UPDATED');
+
+        } else {
+            $sid = 0 ;
+            &Debug("Bad commit on $job Job Status update");
+        }
+
+        &TIMESTAT('JOBSTATUS-DB-UPDATE');
+
+    } else {
+        # Insert a new row
+
+        # Do a table optimization and purge at last every 60 minutes
+        &Warn("jobs_status DB table not optimized and purged")
+            unless (&job_status_purge());
+
+        &TIMESTAT('JOBSTATUS-DB-INSERT');
+        &Debug("Insert '@row' into jobs_status table");
+        # Insert new jobstatus in table
+        my $insert = $DBH->prepare_cached(qq{
+            INSERT INTO ${A2PDB_TABLE_PREFIX}jobs_status
+                (serviceid,JobID,Revision,Timer,Step,Steps,
+                Born,Date,JobName,CurrentStatus,NbJobs,DestIDs,Infos)
+                VALUES(?,?,?,?,?,?,?,?,?,?,?,?,?)
+            });
+
+        &UPSTAT('JOBSTATUS-DB-INSERT');
+        my $executed = $insert->execute(@row)
+            || &Error("Can't insert '$row[1]' JobID in job_status table: ".
+               $DBH->errstr());
+
+        # Return the sid inserted
+        if ($executed and $DBH->commit()) {
+            $sid = &mysql_insert_id() ;
+            &UPSTAT('JOBSTATUS-DB-INSERTED');
+            &MAXMINSTAT('JOBSTATUS-BORN-TO-DB-TIMING-ms', &_ms() - $row[6]);
+            &Debug("Last insertid SID is $sid");
+
+        } elsif ($executed) {
+            &Error("No sid retrieved for '$row[1]' Job Status insertion");
+        }
+
+        &TIMESTAT('JOBSTATUS-DB-INSERT');
+    }
+
+    return $sid ;
+}
+
+my %optimize = () ; # Time out list
+sub optimize_table {
+    return unless ($DO_DB_OPTIMIZATION);
+    my $table = shift or return "" ;
+
+    # Do a table optimization if 1 hour has pasted since last optimization
+    return 0 if ( exists($optimize{$table}) and time < $optimize{$table} );
+
+    # Protect table name
+    return 0 unless ( $table =~ /^\w+$/ );
+
+    # Set time out to next hour
+    $optimize{$table} = time + 3600 ;
+
+    &TIMESTAT(uc($table).'-TABLE-OPTIMIZATION');
+    # Do table optimization and disable it if it fails
+    unless ($DBH->do("OPTIMIZE TABLE ${A2PDB_TABLE_PREFIX}$table")) {
+        &Info("Can't optimize $table DB table");
+        # Don't try to optimize until next service restart
+        $optimize{$table} = [] ;
+    }
+    &TIMESTAT(uc($table).'-TABLE-OPTIMIZATION');
+    &UPSTAT(uc($table).'-TABLE-OPTIMIZED');
+
+    return $optimize{$table} ;
+}
+
+sub job_status_delete {
+    # A valid SID must be provided
+    my $sid = shift || return 0 ;
+    return 0 unless ($sid =~ /^\d+$/);
+
+    $DBH->do(qq{
+        DELETE FROM ${A2PDB_TABLE_PREFIX}jobs_status
+        WHERE sid=$sid
+        })
+        or return &Error("Can't delete row $sid in jobs_status DB table");
+
+    $DBH->commit()
+        or &Error("Can't commit row $sid deletion in jobs_status DB table");
+    &UPSTAT('JOBSTATUS-DB-DELETE');
+    &Debug("Deleted status with sid $sid in DB");
+
+    # Do a table optimization and purge at last every 60 minutes
+    &Warn("jobs_status DB table not optimized and purged")
+        unless (&job_status_purge());
+
+    return 1 ;
+}
+
+my $purge_timout = 0 ;
+sub job_status_purge {
+    # Prevent purge too soon by calling optimize_table just before which will
+    # will return true only every half an hour
+    return 1 unless ( $STATUS_DB_MAXAGE and time > $purge_timout );
+
+    # Reset time out
+    $purge_timout = time + 1800 ;
+
+    # Delete max_aged rows, Timer is ms avec parameter is hour
+    my $time    = time * 1000 ;
+    my $timeout = $time - 3600000 * $STATUS_DB_MAXAGE ;
+
+    unless ($NO_SYSLOG_DEBUG) {
+        # Log which row will be deleted when debug mode is activated
+        &Debug("Try deleting job status row at time $time ms since EPOCH...");
+        &Debug("Deleting any job status DB row with Timer lower than $timeout");
+        my $select = $DBH->prepare_cached(qq{
+            SELECT s.LockID,j.JobID,j.Revision,j.Timer,j.Step,j.Steps,
+                   j.Born,j.JobName,j.CurrentStatus,j.NbJobs,j.Infos,j.dbtime
+            FROM ${A2PDB_TABLE_PREFIX}Services s,
+                 ${A2PDB_TABLE_PREFIX}jobs_status j
+            WHERE j.Timer<? AND j.CurrentStatus LIKE 'DONE'
+                AND s.serviceid=j.serviceid
+        });
+
+        if ($select->execute($timeout)) {
+            while ( my @row = $select->fetchrow_array ) {
+                &Debug("Deleting status row: @row");
+            }
+        }
+
+        $select->finish ;
+    }
+
+    # DO DELETE
+    $DBH->do(qq{
+        DELETE FROM ${A2PDB_TABLE_PREFIX}jobs_status
+        WHERE CurrentStatus LIKE 'DONE' AND Timer<$timeout
+    })
+        or return &Error("Can't do aged deletion in jobs_status table");
+
+    $DBH->commit()
+        or return &Error("Can't commit aged deletion in jobs_status table");
+
+    # Finaly optimize the table
+    &optimize_table('jobs_status');
+
+    return 1 ;
+}
+
+sub is_job_status_updated {
+    my $sid = shift or return 0 ;
+    my $rev = shift || 0 ;
+
+    return 0 unless (&a2p_db_connected);
+
+    my $select = $DBH->prepare_cached(qq{
+          SELECT s.LockID,j.JobID,j.Revision,j.Timer,j.Step,j.Steps,
+                 j.Born,j.Date,j.JobName,j.CurrentStatus,j.NbJobs
+          FROM ${A2PDB_TABLE_PREFIX}Services s, ${A2PDB_TABLE_PREFIX}jobs_status j
+        WHERE j.sid=? and s.serviceid=j.serviceid
+        });
+
+    $select->execute($sid)
+        or return &Error("Can't check $sid SID update in jobs_status table: ".
+            $DBH->errstr());
+
+    my @row = $select->fetchrow_array ;
+    $select->finish ;
+
+    &UPSTAT('JOBSTATUS-DB-IS-UPDATED?');
+
+    # Check if revision has been updated
+    if ( $row[2] > $rev ) {
+        &Debug("Found new revision $row[2] for $row[1] (sid=$sid) in DB");
+        return @row ;
+    } else {
+        return () ;
+    }
+}
+
+# List of accepted filter and the corresponding SQL statement to add computed
+# in a sprintf call with the transmitted value
+my %sql_filters = (
+    LOCKID      =>  "s.LockID LIKE '%s'",
+    NAME        =>  "( j.JobID LIKE '*%s*' OR j.JobName LIKE '*%s*' )",
+    DAY         =>  "j.Date LIKE '%s'",
+    STATUS      =>  {
+        'any'            => [ "j.CurrentStatus LIKE 'AB%'",
+                              "j.CurrentStatus LIKE 'KO'",
+                              "NOT ( j.CurrentStatus LIKE 'DO%'
+                              OR j.CurrentStatus LIKE 'KO'
+                              OR j.CurrentStatus LIKE 'AB%' )",
+                              "j.CurrentStatus LIKE 'DO%'" ],
+        'done'           => [ "j.CurrentStatus LIKE 'DO%'" ],
+        'ko|abterm'      => [ "j.CurrentStatus LIKE 'AB%'",
+                              "j.CurrentStatus LIKE 'KO'" ],
+        'done|ko|abterm' => [ "j.CurrentStatus LIKE 'AB%'",
+                              "j.CurrentStatus LIKE 'KO'",
+                              "j.CurrentStatus LIKE 'DO%'" ],
+        },
+    NOTSTATUS   =>  {
+        'done'           => [
+            "j.CurrentStatus LIKE 'AB%'",
+            "j.CurrentStatus LIKE 'KO'",
+            "NOT ( j.CurrentStatus LIKE 'DO%' OR j.CurrentStatus LIKE 'KO'
+            OR j.CurrentStatus LIKE 'AB%' )" ],
+        'done|ko|abterm' => [ "NOT ( j.CurrentStatus LIKE 'DO%'
+            OR j.CurrentStatus LIKE 'KO' OR j.CurrentStatus LIKE 'AB%' )" ],
+        'ko|abterm'      => [ "NOT ( j.CurrentStatus LIKE 'DO%'
+            OR j.CurrentStatus LIKE 'KO' OR j.CurrentStatus LIKE 'AB%' )",
+            "j.CurrentStatus LIKE 'DO%'" ]
+        },
+    DESTID      =>  "j.DestIDs LIKE '*%s*'"
+);
+
+my $get_next_select ;
+my $get_next_count ;
+my @statements = () ;
+sub get_next_jobstatus {
+
+    &a2p_db_connect unless $DBH ;
+
+    unless (defined($get_next_select) and $get_next_select) {
+        my $sid = shift || 0 ;
+        $sid = 0 unless ( $sid =~ /^\d+$/ );
+        my $sql = '' ;
+
+        # Prepare SQL template
+        my $template = qq{
+              SELECT j.sid as SID, s.LockID as LOCKID, j.JobID as JOBID,
+                     j.Revision as REV, j.Timer as TIMER, j.Step as STEP ,
+                     j.Steps as STATE, j.Born as BORN, j.Date as DAY,
+                     j.JobName as AFP, j.CurrentStatus as STATUS,
+                     j.NbJobs as NBJOBS, j.DestIDs as DESTIDS, j.Infos as INFOS,
+                     j.dbtime as DBTIME
+              FROM
+                   ${A2PDB_TABLE_PREFIX}Services s,
+                   ${A2PDB_TABLE_PREFIX}jobs_status j
+            WHERE j.sid>$sid AND s.serviceid=j.serviceid
+            %s
+            ORDER BY SID DESC
+            %s
+            } ;
+
+        $get_next_count = 0 ;
+
+        # Compute a SQL statement to add as WHERE to get faster requests
+        my $filter = "" ;
+        my $limit  = "" ;
+
+        # Filters must be provided in a hash as column/like value pairs
+        if ( @_ and defined($_[0]) and $_[0] ) {
+            my $hash = shift ;
+
+            # Check if we are limited in row number to retrieve
+            if ( exists($hash->{LIMIT}) ) {
+                $limit = " LIMIT 0," . $hash->{LIMIT}
+                    if ( $hash->{LIMIT} =~ /^\d+$/ );
+                delete $hash->{LIMIT} ;
+            }
+
+            # Check status filter
+            my @Status = () ;
+            my ( $status_key ) = grep { /STATUS/i } keys(%{$hash}) ;
+            if ( $status_key ) {
+                @Status = @{$sql_filters{$status_key}->{$hash->{$status_key}}} ;
+                delete $hash->{$status_key} ;
+
+            } else {
+                @Status = @{$sql_filters{'STATUS'}->{'any'}} ;
+            }
+
+            # Check other keys to prepare filter
+            foreach my $key ( keys(%{$hash}) ) {
+                next unless (exists($sql_filters{$key}));
+                my $value = $hash->{$key} ;
+                if (ref($sql_filters{$key}) =~ /^HASH/i) {
+                    $filter .= " AND " . $sql_filters{$key}->{$value} ;
+
+                } else {
+                    # Strip illegal chars
+                    $value =~ s/[^%*0-9A-Za-z_.-]//g ;
+                    $filter .= " AND " . sprintf($sql_filters{$key},$value) ;
+                }
+            }
+
+            # Prepare definitive SQL
+            @statements = map {
+                sprintf( $template, ' AND ' . $_ . $filter, $limit )
+            } @Status ;
+            $sql = shift @statements ;
+
+        } else {
+            # Set default statement
+            $sql = sprintf( $template, '' );
+            @statements = () ;
+        }
+
+        $get_next_select = $DBH->prepare_cached($sql);
+        $get_next_select->execute()
+            or return $get_next_select = &Error("Can't get jobs status in " .
+                "jobs_status table: " . $DBH->errstr());
+    }
+
+    my $row = $get_next_select->fetchrow_hashref ;
+
+    # Try next statements in list when available
+    while ( !(defined($row) or ref($row) =~ /^HASH/) and @statements ) {
+        if ($DBH->errstr) {
+            &Error("Problem when retrieving jobs status in jobs_status table: ".
+                $DBH->errstr());
+        }
+        $get_next_select->finish ;
+        my $sql = shift @statements ;
+        if ( defined($sql) and $sql ) {
+            $get_next_select = $DBH->prepare_cached($sql);
+            $get_next_select->execute()
+                or return $get_next_select = &Error("Can't get jobs status " .
+                    "with next statement: " . $DBH->errstr());
+            $row = $get_next_select->fetchrow_hashref ;
+        }
+    }
+
+    unless (defined($row) and ref($row) =~ /^HASH/) {
+        &MAXSTAT('JOBSTATUS-DB-GET',$get_next_count);
+        if ($DBH->errstr) {
+            &Error("Problem when retrieving jobs status in jobs_status table: ".
+                $DBH->errstr());
+        }
+        $get_next_select->finish ;
+        $get_next_select = undef ;
+        &a2p_db_disconnect ;
+    }
+
+    return $row ;
+}
+
+sub job_queue_update {
+    my $jid  = shift || 0 ;
+    my $mode = shift || 0 ;
+    my $serv = shift || 0 ;
+    my $name = shift || "";
+    my $afp  = shift || "" ;
+    my $rev  = shift || 0 ; # set it to negative value to delete the jid ref row
+    my $data = shift ;
+
+    &a2p_db_connect unless $DBH ;
+
+    if (!defined($data)) {
+        # This is a synchronization check or a delete request
+        if ( $jid and $rev >= 0 ) {
+            &TIMESTAT('A2PJOB-DB-SYNC');
+
+            # Prepare to update a row if revision is not up to date
+            my $synchro = $DBH->prepare_cached(qq{
+                SELECT Revision, Object
+                FROM ${A2PDB_TABLE_PREFIX}jobs_queue
+                WHERE jid = ?
+                });
+
+            &Debug("Syncing $name rev$rev in jobs_queue table");
+            &UPSTAT('A2PJOB-DB-SYNC');
+
+            $synchro->execute($jid)
+                or $jid = &Error("Can't update $name in db: ".$DBH->errstr());
+            my @synchro = $synchro->fetchrow_array ;
+            $synchro->finish ;
+
+            &TIMESTAT('A2PJOB-DB-UPDATE');
+            return $synchro[0] > $rev ? $synchro[1] : undef ;
+
+        } elsif ( $jid and $jid =~ /^\d+$/ and $rev < 0 ) {
+            &TIMESTAT('A2PJOB-DB-DELETE');
+            &Debug("Deleting row $jid of $name in jobs_queue table");
+
+            # Request deletion in DB
+            my $result = $DBH->do(qq{
+                DELETE FROM ${A2PDB_TABLE_PREFIX}jobs_queue
+                WHERE jid=$jid
+                })
+                || &Error("Can't delete row $jid in jobs_queue DB table");
+
+            $result = $DBH->commit()
+                || &Error("Can't commit row $jid deletion in jobs_queue table")
+                if ($result);
+
+            &TIMESTAT('A2PJOB-DB-DELETE');
+            return undef unless $result ;
+            &UPSTAT('A2PJOB-DB-DELETE');
+
+            # Do a table optimization at some time
+            &optimize_table('jobs_queue');
+
+            return $result ;
+
+        } elsif ($jid) {
+            &Error("Invalid '$jid' jid detected");
+            return undef ;
+
+        } else {
+            &Error("Can't synchronize '$name' without jid set");
+            return undef ;
+        }
+    }
+
+    # Check if jobname is in DB and then get the jid
+    if (!$jid and ($name or $afp)) {
+        &TIMESTAT('A2PJOB-DB-FIND-JID');
+        # Prepare to update a row if revision is not up to date
+        my $select ;
+        if ($name) {
+            $select = $DBH->prepare_cached(qq{
+                SELECT jid FROM ${A2PDB_TABLE_PREFIX}jobs_queue
+                WHERE JobID=?
+                });
+        } else {
+            $select = $DBH->prepare_cached(qq{
+                SELECT jid FROM ${A2PDB_TABLE_PREFIX}jobs_queue
+                WHERE Jobname=?
+                });
+        }
+
+        &UPSTAT('A2PJOB-DB-CHECKJID');
+
+        &Debug("Check if job $name or $afp is in DB");
+        $select->execute( $name ? $name : $afp )
+            or return &Error("Can't check JID in jobs_queue table: ".
+                $DBH->errstr());
+
+        my ( $thisjid ) = $select->fetchrow_array ;
+        $select->finish ;
+        $jid = $thisjid
+            if (defined($thisjid) and $thisjid);
+        &TIMESTAT('A2PJOB-DB-FIND-JID');
+    }
+
+    if ($jid) {
+        &TIMESTAT('A2PJOB-DB-UPDATE');
+        # Prepare to update a row if revision is not up to date
+        my $update = $DBH->prepare_cached(qq{
+            UPDATE ${A2PDB_TABLE_PREFIX}jobs_queue
+            SET Mode=?, serviceid=?, JobID=?, JobName=?, Revision=?, Object=?
+            WHERE jid=?
+            });
+
+        &Debug("Updating $name rev$rev in jobs_queue table");
+        &UPSTAT('A2PJOB-DB-UPDATE');
+
+        $update->execute($mode, $serv, $name, $afp, $rev, $data, $jid)
+            or $jid = &Error("Can't update $name in db: ".$DBH->errstr());
+
+        if ($jid and $DBH->commit()) {
+            &UPSTAT('A2PJOB-DB-UPDATED');
+
+        } else {
+            $jid = 0 ;
+            &Warn("Bad commit on $name AfpJob update");
+        }
+
+        &TIMESTAT('A2PJOB-DB-UPDATE');
+
+    } elsif ($name) {
+        &TIMESTAT('A2PJOB-DB-INSERT');
+        &Debug("Inserting '$name', '$afp' into jobs_queue table");
+        # Insert new jobstatus in table
+        my $insert = $DBH->prepare_cached(qq{
+            INSERT INTO ${A2PDB_TABLE_PREFIX}jobs_queue
+                (Mode,serviceid,JobID,JobName,Revision,Object)
+                VALUES(?,?,?,?,?,?)
+            });
+
+        &UPSTAT('A2PJOB-DB-INSERT');
+        my $executed = $insert->execute($mode,$serv,$name, $afp, $rev, $data)
+            || &Error("Can't insert '$name' AfpJob in jobs_queue table: ".
+               $DBH->errstr());
+
+        # Return the sid inserted
+        if ($executed and $DBH->commit()) {
+            $jid = &mysql_insert_id() ;
+            &UPSTAT('A2PJOB-DB-INSERTED');
+
+        } elsif ($executed) {
+            &Error("No jid retrieved for '$name' AfpJob insertion");
+        }
+
+        &TIMESTAT('A2PJOB-DB-INSERT');
+    }
+
+    return $jid ;
+}
+
+my $get_next_afpjob_select ;
+my $get_next_afpjob_count ;
+sub get_next_afpjob {
+    my $mode = shift || 0 ;
+    my $serviceid = shift || 0 ;
+
+    return 0 unless (&a2p_db_connected);
+
+    unless (defined($get_next_afpjob_select) and $get_next_afpjob_select) {
+        $get_next_afpjob_count = 0 ;
+
+        # Necessary to make the next SELECT working
+        $DBH->commit();
+
+        if ($serviceid) {
+            &UPSTAT('A2PJOB-DB-CHECK-SERVICEID-'.$serviceid);
+            $get_next_afpjob_select = $DBH->prepare_cached( qq{
+                  SELECT j.jid as JID, j.Mode as MODE, j.JobID as JOBID,
+                         j.JobName as JOBNAME, j.Revision as REV,
+                         j.Object as THAWN, j.dbtime as DBTIME
+                  FROM
+                       ${A2PDB_TABLE_PREFIX}jobs_queue j
+                WHERE Mode=? AND serviceid=?
+                ORDER BY JID DESC
+                } );
+            $get_next_afpjob_select->execute($mode,$serviceid)
+                or return $get_next_afpjob_select = &Error(
+                "Can't get rows in jobs_queue table for serviceid $serviceid:" .
+                $DBH->errstr());
+
+        } else {
+            &UPSTAT('A2PJOB-DB-CHECK-SERVICEID-UNDEF');
+            $get_next_afpjob_select = $DBH->prepare_cached( qq{
+                  SELECT j.jid as JID, j.Mode as MODE, j.JobID as JOBID,
+                         j.JobName as JOBNAME, j.Revision as REV,
+                         j.Object as THAWN, j.dbtime as DBTIME
+                  FROM
+                       ${A2PDB_TABLE_PREFIX}jobs_queue j
+                WHERE Mode=?
+                ORDER BY JID DESC
+                } );
+            $get_next_afpjob_select->execute($mode)
+                or return $get_next_afpjob_select = &Error(
+                "Can't get rows in jobs_queue table in mode $mode: " .
+                $DBH->errstr());
+        }
+    }
+
+    my $row = $get_next_afpjob_select->fetchrow_hashref ;
+
+    unless (defined($row) and ref($row) =~ /^HASH/) {
+        &UPSTAT('A2PJOB-DB-ALL-GOT');
+        &MAXSTAT('A2PJOB-DB-GET',$get_next_afpjob_count);
+        if ($DBH->errstr) {
+            &Error("Error when retrieving afpjob objects in jobs_queue table: ".
+                $DBH->errstr());
+        }
+        $get_next_afpjob_select->finish ;
+        undef $get_next_afpjob_select ;
+
+        # Avoid disconnection in a2p-status
+        &a2p_db_disconnect unless ($serviceid);
+
+        $row = 0 ;
+    }
+
+    return $row ;
+}
+
+sub a2p_db_avoid_disconnect_in_forked {
+    # This sub must be called in forked processes to avoid closing parent
+    # connections when forked process is exiting
+    $DBH->{'InactiveDestroy'} = 1 if (defined($DBH) and $DBH);
+}
+
+################################################################################
+### Module End
+################################################################################
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
Index: /A2P/a2p/A2P/EService.pm
===================================================================
--- /A2P/a2p/A2P/EService.pm	(revision 3)
+++ /A2P/a2p/A2P/EService.pm	(revision 3)
@@ -0,0 +1,307 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+package A2P::EService ;
+
+# Derived class from Thread.pm
+use base qw(A2P::Thread);
+
+use strict ;
+use integer ;
+use IO::Socket ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use A2P::Com qw( IsCom comJOB comFILE );
+use A2P::XML ;
+use A2P::JobStatus 'a2pjobstate' ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 885 $ =~ /(\d[0-9.]+)\s+/ ;
+}
+our $VERSION ;
+
+################################################################################
+##             E-Service thread object                                        ##
+################################################################################
+sub Do {
+    my $self = shift ;
+    my $ref  = shift ;
+
+    my $Ret = 0 ;
+    $! = 0 ;
+
+    my $OLDERR ;
+    my $errfile ;
+
+    my @Job = &IsCom( comJOB , $$ref );
+
+    if ( @Job == 2 ) {
+        my ( $Job , $req ) = @Job ;
+
+        &Debug("Received E-Service request for $Job");
+        $ENV{JOB} = $self->{JOB} = $Job ;
+
+        # Keep internal stats
+        &UPSTAT('E-SERVICE_REQ');
+
+        # E-Service main sub-routine connector
+        if ( $ESERVICE_ENABLED < 100 ) {
+            my @service ;
+
+            # Extract the request as comFILE
+            my @Req = &IsCom( comFILE , $req );
+
+            if ( @Req == 2 and -e $Req[1] ) {
+                my ( $Service , $A2PXML ) = @Req ;
+                &Debug("Got request on '$Service' E-Service for $Job job",
+                    "Request comes with '$A2PXML' A2P xml");
+
+                my $conf = $self->getconf ;
+                if ( defined($conf) and @service = $conf->getbin($Service)
+                and ! $conf->error) {
+                    # Service array should be the binary full path plus the
+                    # calling mode:
+                    # mode 0: We should send the A2P xml on the STDIN of program
+                    # mode 1: We should launch program with A2P xml full path as
+                    #         first and only argument
+                    my $mode = pop @service ;
+
+                    # Redirect STDERR to a file
+                    open $OLDERR, ">&", \*STDERR or undef $OLDERR ;
+
+                    if (defined($OLDERR)) {
+                        open STDERR, '>', $errfile = $A2PXML . '.stderr'
+                            or undef $OLDERR ;
+                    }
+
+                    # Unbufferize STDERR
+                    select STDERR ; $| = 1 ; select STDOUT ;
+
+                    if ( $mode == 0 ) {
+                        &Debug("Executing '@service' in mode 0: XML on STDIN");
+                        my $XML ;
+                        # Launch program sending a2p xml content on stdin
+                        unless( open($XML , '<', $A2PXML) ) {
+                            $Ret = scalar($!) ;
+                            $self->ABTERM("Can't open $A2PXML for reading: $!");
+                        }
+
+                        my $SERVICE ;
+                        my $pid = defined($XML) ?
+                            open( $SERVICE, '|-', @service ) : undef ;
+
+                        bless $SERVICE , "IO::Socket" ;
+                        $SERVICE->autoflush(1);
+
+                        if (defined($pid)) {
+                            &Warn("Can't print to '@service' stdin: $!")
+                                  unless print { $SERVICE } <$XML> ;
+
+                            &Debug("Waiting son[$pid] has finished");
+                            my $test = waitpid $pid, 0 ;
+                            &Debug("Son[$pid] has finished");
+
+                            &Warn("Not expected terminating son ($test)")
+                                unless ($test == $pid);
+
+                            my $result = $?;
+                            $Ret       = $result >> 8;
+                            my $signal = $result & 127;
+                            my $cd     = $result & 128 ? "with core dump" : "";
+
+                            $self->ABTERM("Execution of '@service' failed $cd: "
+                                . "exit=$Ret signal=$signal")
+                                if ($Ret or $cd);
+
+                            close($SERVICE);
+
+                        } else {
+                            $Ret = scalar($!) ;
+                            $self->ABTERM("Can't fork to start '@service': $!")
+                                if (defined($XML));
+                        }
+
+                        close($XML);
+
+                    } elsif ( $mode == 1 ) {
+                        &Debug("Executing '@service' in mode 1: XML as ARGV");
+                        # Launch program with full path to a2p xml content
+                        # as argument
+                        my $pid = fork ;
+
+                        push @service , $A2PXML ;
+
+                        if (defined $pid) {
+
+                            unless ($pid) {
+                                # As forked try to exec the program
+                                exec @service
+                                    or die "Cannot exec '@service': $!\n";
+                            }
+
+                            wait ;
+
+                            my $result = $?;
+                            $Ret       = $result >> 8;
+                            my $signal = $result & 127;
+                            my $cd     = $result & 128 ? "with core dump" : "";
+
+                            $self->ABTERM("Execution of '@service' failed $cd: "
+                                . "exit=$Ret signal=$signal")
+                                if ($Ret or $cd);
+
+                        } else {
+                            $Ret = scalar($!) ;
+                            $self->ABTERM("Can't fork to start '@service': $!");
+                        }
+
+                    } else {
+                        $Ret = 20 + scalar($mode) ;
+                        $self->ABTERM("E-Service '@service' mode '$mode' " .
+                            "is not supported");
+                    }
+
+                    # Re-open old STDERR
+                    if (defined($OLDERR)) {
+                        close(STDERR);
+                        open STDERR, '>&', $OLDERR ;
+
+                    } else {
+                        undef $errfile ;
+                    }
+
+                    undef $OLDERR ;
+
+                } else {
+                    $Ret = 19 ;
+                    if (defined($conf) and $conf->error) {
+                        my @error = $conf->error ;
+                        $self->ABTERM("XML conf error $error[0]: $error[1]");
+                    }
+                    $self->ABTERM("E-Service '$Service' not configurated");
+                }
+
+            } elsif ( @Req == 2 and ! -e $Req[1] ) {
+                $Ret = 15 ;
+                $self->ABTERM("Can't start '$Req[0]' E-Service request " .
+                    "without a2p xml content");
+
+            } else {
+                $Ret = 10 ;
+                $self->ABTERM("Can't understand E-Service request '$req'");
+            }
+
+        } else {
+            # E-Service can just be simulated
+            $Ret = $ESERVICE_ENABLED == 100 ? 0 :
+                ( rand($ESERVICE_ENABLED) > 99 ? 1 : 0 ) ;
+        }
+
+        # Keep status and log error
+        my $status_step = 'o' ;
+        my $status = { JID => $Job , STATUS => 'TRANSMITTED' } ;
+
+        if ($Ret) {
+            $self->ABTERM("E-Service transmission returned with value $Ret" .
+                (($!)? ": $! $? $@" : ""));
+            $status->{ABTERM} = 'Not transmitted';
+            $status->{STATUS} = 'KO' ;
+            $status_step = 'A' ;
+
+            # Try to read STDERR file for an ABTERM
+            if (defined($errfile) and -s $errfile) {
+                if (open( FILE, '<', $errfile )) {
+                    while (<FILE>) {
+                        if ( /^ABTERM:(.*)$/i ) {
+                            $status->{INFOS} = $1 ;
+                            last ;
+                        }
+                    }
+                    close(FILE);
+                }
+            }
+        }
+
+        my ( $JobId ) = $Job =~ /^(.*)-\d+$/ ;
+        &a2pjobstate( $JobId || $Job , 10, $status_step, $status )
+            or &Info("Can't set job status '$status_step'");
+
+        # Keep internal stats
+        $Ret ? &UPSTAT('BAD_E-SERVICE_REQ') : &UPSTAT('GOOD_E-SERVICE_REQ');
+
+        # Return the result
+        $self->Return( $Job , $Ret ? $Ret : DONE );
+        $self->AnswerDone( $Job );
+
+        # Not processing a job now
+        $ENV{JOB} = $self->{JOB} = "" ;
+
+    } else {
+        # Keep internal stats
+        &UPSTAT('BAD_E-SERVICE_FORMAT');
+
+        $self->ABTERM("Can't understand request '$$ref'");
+
+        $Ret = 9 ;
+    }
+
+    return $Ret ? 0 : 1 ;
+}
+
+my $XMLCONF ;
+sub getconf {
+    my $self = shift ;
+
+    # Check file availability
+    unless ( -e $ESERVICE_CONF ) {
+        $self->ABTERM("E-Service configuration '$ESERVICE_CONF' unavailable");
+        return $XMLCONF = undef ;
+    }
+
+    # Check if we still have an XML object to handle E-Service configuration
+    unless (defined($XMLCONF) and ref($XMLCONF) =~ /^A2P::XML$/ ) {
+        &Debug("Creating new XML object to handle E-Service configuration");
+        $XMLCONF = new A2P::XML ;
+    }
+
+    return $XMLCONF = undef
+        unless ($XMLCONF->setDTD('e-service.conf.dtd'));
+
+    $XMLCONF = undef
+        unless ( $XMLCONF->parse_file( $ESERVICE_CONF ) eq $ESERVICE_CONF );
+
+    return $XMLCONF ;
+}
+
+sub ThreadInit {
+    my $self = shift ;
+
+    # Can be only in ABTERM condition
+    $self->{STEP} = 10 ;
+
+    # Update PERL5LIB with our @INC list
+    $ENV{PERL5LIB} = join(':',@INC);
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
Index: /A2P/a2p/A2P/EService/SimpleXML.pm
===================================================================
--- /A2P/a2p/A2P/EService/SimpleXML.pm	(revision 3)
+++ /A2P/a2p/A2P/EService/SimpleXML.pm	(revision 3)
@@ -0,0 +1,169 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+package A2P::EService::SimpleXML ;
+
+# API to handle XML format
+
+use strict ;
+use XML::LibXML ;
+use A2P::EService::Tools qw( abort ) ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 836 $ =~ /(\d[0-9.]+)\s+/ ;
+}
+our $VERSION ;
+
+sub new {
+    my $class = shift ;
+
+    my $parser = new XML::LibXML ;
+    abort "Unable to get an XML parser" unless (defined($parser));
+
+    my $self = {
+        PARSER => $parser,
+        NODES  => {}
+    };
+
+    bless $self, $class ;
+
+    # Still a file if called with an argument
+    $self->loadfile($_[0]) if @_ ;
+
+    return $self ;
+}
+
+sub loadfile {
+    my $self = shift ;
+    my $file = shift or abort "No XML file given to load" ;
+
+    abort "Bad XMLfile found" unless -s $file ;
+
+    my $xml = $self->{PARSER}->parse_file( $file );
+    abort "Can't parse '$file' as XML" unless (defined($xml));
+
+    # Keep trace of encoding
+    $self->{ENCODING} = lc( $xml->encoding() || '' );
+
+    my $root = $xml->lastChild ;
+    abort "No XML root found in file" unless (defined($root));
+
+    return $self->{ROOT} = $root ;
+}
+
+sub encoding {
+    my $self = shift ;
+    return defined($self->{ENCODING}) ? $self->{ENCODING} : '' ;
+}
+
+sub root {
+    my $self = shift ;
+    return defined($self->{ROOT}) ? $self->{ROOT} : '' ;
+}
+
+sub name {
+    my $root = $_[0]->root ;
+    return $root ? $root->nodeName : '' ;
+}
+
+sub attribut {
+    my $root = $_[0]->root ;
+    my $name = $_[1] or return '' ;
+    return $root ? $root->getAttribute($name) : '' ;
+}
+
+sub content {
+    my $self = shift ;
+    my $root = $self->root ;
+    my $content = $root ? $root->textContent : '' ;
+
+    # Strip first empty lines due to XML format
+    ( $content ) = $content =~ /^\n*(.*)$/ms if $content ;
+
+    return $content ;
+}
+
+sub nodes {
+    my $self = shift ;
+    my $name = shift or return () ;
+    my $filter = shift || {} ;
+
+    my %attrib = () ;
+    while (@_) {
+        my $attribut = shift ;
+        $attrib{$attribut} = "" ;
+    }
+
+    # Control attribut filter is a hash list
+    $filter = {} unless (ref($filter) =~ /^HASH/i);
+
+    # Use cached nodes if still passed here
+    my @nodes ;
+    if ( exists($self->{NODES}->{$name})
+    and ref($self->{NODES}->{$name}) =~ /^ARRAY/i ) {
+        @nodes = @{$self->{NODES}->{$name}} ;
+
+    } else {
+        my $root ;
+        # Return no node value if root is not available
+        return () unless ( $root = $self->root );
+
+        # Get nodes
+        @nodes = $root->getChildrenByTagName($name);
+
+        # Unbind nodes to skip retreiving their content in the body
+        map { $_->unbindNode } @nodes ;
+
+        # Keep the list in cache
+        $self->{NODES}->{$name} = \@nodes ;
+    }
+
+    my @values = () ;
+    foreach my $node ( @nodes ) {
+        # Check if this node is to return
+        my $filtered = 0 ;
+        foreach my $key (keys(%{$filter})) {
+            $filtered ++ ;
+            my $match = $filter->{$key} ;
+            my $value = $node->getAttribute($key) || "" ;
+            next unless ( $value =~ /^$match$/ );
+            $filtered = 0 ;
+            last ;
+        }
+        next if $filtered ;
+
+        my $found = 0 ;
+        foreach my $attribut (keys(%attrib)) {
+            my $value = $node->getAttribute($attribut) || "" ;
+            next unless ($value);
+            $found ++ ;
+            $attrib{$attribut} = $value ;
+        }
+
+        my $content = $node->textContent || "" ;
+        push @values, $found ? [ $content, \%attrib ] : $content ;
+    }
+
+    return @values ;
+}
+
+1;
Index: /A2P/a2p/A2P/EService/Tools.pm
===================================================================
--- /A2P/a2p/A2P/EService/Tools.pm	(revision 3)
+++ /A2P/a2p/A2P/EService/Tools.pm	(revision 3)
@@ -0,0 +1,194 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+package A2P::EService::Tools ;
+
+# Package of tools API to create E-Service dedicated scripts
+
+use strict ;
+use integer ;
+use Carp qw(longmess);
+use XML::LibXML ;
+
+use A2P::Globals ;
+use A2P::Syslog ;
+
+BEGIN {
+    use Exporter ();
+
+    our $VERSION = sprintf "%s", q$Rev: 885 $ =~ /(\d[0-9.]+)\s+/ ;
+    our @ISA = qw(Exporter);
+    our @EXPORT_OK = qw( &try &abort &get_conf &get_id &get_lib &get_work
+                         &get_useragent );
+}
+
+our $VERSION ;
+our $perllib = '/etc/afp2print/perl5lib' ;
+
+my $try   = "" ;
+my $tries = 0 ;
+my $service = $0 ;
+
+sub try {
+    # Handle Perl signals
+    $SIG{'__DIE__'} = $SIG{'__WARN__'} = sub {
+        &abort(&longmess(@_));
+        };
+
+    $try = shift ;
+    ++ $tries ;
+    print sprintf("Check #%03d: %s\n", $tries, $try )
+        if (exists($ENV{SHOW_TRIES}));
+}
+
+sub abort {
+    # If one argument is given, add it to try string
+    $try .= ": " . shift if @_ ;
+    $try .= " ($!)" if ($!);
+    # Print message only in some environment
+    print "$try\n"
+        if (exists($ENV{A2P_PATH}) or (defined($ENV{DEBUG}) and $ENV{DEBUG}));
+    &Error($try);
+    print STDERR "ABTERM: $try\n" if (defined($ENV{JOB}) and $ENV{JOB});
+    exit($tries);
+}
+
+sub get_conf {
+    $service = shift ;
+    my @required = @_ ;
+
+    # Prepare logging api
+    our $Progname = $0 = $service ;
+    A2P::Syslog::SetLogger(0);
+
+    my $conf_file = $service . '.conf' ;
+
+    # Configuration folder can be over-rided with EADRESSE_CONF environment
+    my $conf_path = defined($ENV{'EADRESSE_CONF'}) ?
+        $ENV{'EADRESSE_CONF'} : '/etc/afp2print/eservice' ;
+
+    # Prepare path to configuration file to 'require' it
+    $conf_path .= '/' unless ( $conf_path =~ m|/$| );
+    $conf_file = $conf_path . $conf_file ;
+
+    abort "No configuration found at $conf_file"
+        unless -e $conf_file ;
+
+    my $conf = {} ;
+    my ( $req, $eval ) = ( "", "" ) ;
+    map {
+        $req  .= 'our %' . $_ . ' ;' ;
+        $eval .= '$conf->{' . $_ . '} = \%' . $_ . ' ; ' ;
+    } @required ;
+
+    eval "$req require '$conf_file' ; $eval"
+        or abort "Can't read '$conf_file' configuration file" ;
+
+    return $conf ;
+}
+
+sub _cons {
+    return substr('bcdfgjklmnprstvxz',rand(17),1);
+}
+
+sub _vowl {
+    return substr('aeiou',rand(5),1);
+}
+
+sub get_id {
+    my $reference = shift || _cons . _vowl . _cons . _vowl . _cons . _vowl ;
+    my $job = $ENV{JOB} || _cons . _vowl . _cons . _vowl . _cons . _vowl ;
+    my $host = lc($LOCKID) ;
+    return sprintf('%s-%s-%x@%s.%s', $job, $reference, $$, $service, $host );
+}
+
+sub get_lib {
+    my $library = shift or return 0 ;
+    my $wanted  = shift || 0 ;
+
+    try "Loading '$library'" ;
+    eval "use lib '$perllib' ; use $library" ;
+
+    my $version = eval '$' . $library . '::VERSION' ;
+    abort "$library version not found" unless (defined($version) and $version);
+    abort "Too old $library version $version not supported"
+        unless ( $version >= $wanted );
+
+    # Reset errno as it is often set during library load
+    $! = 0 ;
+
+    return 1 ;
+}
+
+sub get_useragent {
+    return $service . " v" . A2P_RPM_VERSION ;
+}
+
+sub get_work {
+    # The work to do is provided as pdf and file attribut in a <a2p/> XML
+    my ( $pdf, $file ) = ( "", "" );
+    my $xml ;
+    my @XML ;
+
+    my $parser = new XML::LibXML ;
+    abort "Unable to get an XML parser" unless (defined($parser));
+
+    # Firstly expect job as argument as mode 1
+    if (@ARGV) {
+        # Still abort if got wrong count of arguments
+        abort "Bad argument count with '@ARGV'" unless ( @ARGV == 1 );
+
+        # Argument must be a file
+        my $file = shift @ARGV ;
+        abort "Bad file found" unless -s $file ;
+
+        $xml = $parser->parse_file( $file );
+        abort "Can't parse '$file' as XML" unless (defined($xml));
+
+    } else {
+        # Mode 0
+        my @XML = <STDIN> ;
+        local $" = '' ;
+        $xml = $parser->parse_string("@XML") if @XML ;
+        abort "Can't parse '@XML' string as XML" unless (defined($xml));
+    }
+
+    my $root = $xml->lastChild ;
+    abort "No XML root found in given content" unless (defined($root));
+
+    my $rootname = $root->nodeName() ;
+    abort "XML is not an a2P work to do "
+        unless ( defined($rootname) and $rootname and $rootname =~ /^a2p$/i );
+
+    $pdf  = $root->getAttribute('pdf') ;
+    abort "No 'pdf' attribut found in a2p XML"
+        unless ( defined($pdf) and $pdf );
+
+    $file = $root->getAttribute('file') ;
+    abort "No 'file' attribut found in a2p XML"
+        unless ( defined($file) and $file );
+
+    # return job to do
+    return ( $pdf, $file ) ;
+}
+
+1;
Index: /A2P/a2p/A2P/Globals.pm
===================================================================
--- /A2P/a2p/A2P/Globals.pm	(revision 3)
+++ /A2P/a2p/A2P/Globals.pm	(revision 3)
@@ -0,0 +1,644 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+package A2P::Globals ;
+
+use strict ;
+use Time::HiRes qw( gettimeofday ) ;
+use A2P::Init ;
+
+BEGIN {
+    use Exporter ();
+
+    our ( $VERSION, $SERVICE, @ISA, @EXPORT, @EXPORT_OK, @SHARED );
+
+    $VERSION = sprintf "%s", q$Rev: 1162 $ =~ /(\d[0-9.]+)\s+/ ;
+    $SERVICE = defined($ENV{'LOCKID'}) ? 1 : 0 ;
+
+    @ISA = qw(Exporter);
+
+    # Export every constants
+    @EXPORT = qw(
+        %means &QUIT &PING &_INIT &NOMOREFILE $Progname $StdoutFile
+        &DONE $MUSTQUIT $LISTENER &TODO $maintid $do_file $A2P_SYS_CONF
+        &A2P_RPM_VERSION %STATS &UPSTAT @SHARED &_UPDATE $SYSLOG &TIMESTAT
+        &MAXSTAT &MAXMINSTAT @AbortTime $AFPNAME_REGEX &DOWNSTAT
+        );
+
+    # List of thread shared and updatable variables to export
+# DEV2
+    @SHARED = qw(
+        $NO_SYSLOG_DEBUG $AFPSPOOL $USLEEP $AFP2PRINT_PATH $ARCH_DEBUG
+        $SHMDIR $ERRORSPOOL $DONESPOOL $LOGOPATH $ARCH_SCENARIO $PCL_RESOLUTION
+        $MAXTASK $DESTIDFILE $COMPRESSFILES $DONTZIPPDF $PURGEFILES $DO_PING
+        $PARALLELE_VALIDATION $DVILJ $ZIPOPTIONS $LOCKID $NODEBUG_MOD_LIST
+        $MINFOLDERCOUNT $MAXFOLDERCOUNT $ARCH_REMHOST_TEST $ARCH_REMPORT_TEST
+        $ARCH_REMHOST_TLOG $ARCH_REMPORT_TLOG $ARCH_REMHOST_PROD $PNGCOMPRESSION
+        $MAIL_BIN $ALERT_MAILS $ERROR_MAILS $LOGFILENAME $SPOOL_PREFIX
+        $LOGFILE_VS_SYSLOG $ARCH_ENABLED $USE_PCLCMD $LOGFILE_PURGE $KEEP_AFPJOB
+        $COM_BURST $SCAN_SPOOL $MAX_BACKLOG $WAIT_ON_PREFIX $MAXRETRYTIMER
+        $CLIENT_TIMEOUT $START_LOGGER $NODEBUG_SUB_LIST $CONV_STATUS_TIMING
+        $KEEP_STATS $STATS_FOLDER $MAXFILES_BY_ZIPCMD $SYSLOG_PATH
+        $KEEP_JOBSTATUS $DONT_PRINT $FORCE_DESTID $SPOOL_TIMER $GIFTOPCL
+        $AGREGATE_PRINT $BACKEND_FACTOR $SERVICE_TMP $COM_LOCKING $MAXJOBS
+        $SERVICE_DEBUG $STDOUT_DEBUG $MAX_BUFFER_SIZE $DEBUG_IN_FILE
+        $ADDTEX_DEBUG $TEX_PAGEDEF_DEBUG $TEX_OVERLAY_DEBUG $TEX_SEGMENT_DEBUG
+        $TEX_SHOW_SEGMENT $ADVANCED_DEBUGGING $ARCH_REMPORT_PROD
+        $KEEP_DYNAMIC_JOB_LOG $JOB_DUMP_ON_ERROR $JOIN_ZIP_ON_ERROR
+        $CLEAN_OPTIMIZATION $DYNAMIC_USLEEP $MAX_DYNAMIC_USLEEP $MAX_CONV_RATE
+        $ADDTEX_DOCINFO $ADDPCL_JOBNAME $ADDPCL_USERNAME $ONLY_DO_PDF
+        $MAXCONNECTIONS $USE_TCPIP_SOCKET $USE_TCPIP_PORT $USE_ONLY_LOOPBACK
+        $AUTHORIZED_HOST $ESERVICE_ENABLED $ESERVICE_CONF $CONVERT_CONTENT_FILE
+        $CLOSE_CONNECTIONS $ENABLE_DTD_VALIDATION $DOCSFILE $STATUS_DB_MAXAGE
+        $DOCUMENTS_CORRECTION_ENABLED $DBI_DSN $DBI_USER $DBI_PASSWD
+        $A2PDB_TABLE_PREFIX $STATSFILE_MAXAGE $STATUS_MAXAGE $DO_CONVERT
+        $FROM_CONVERT $TO_CONVERT $STATS_COMMIT_SKIP $MAX_CACHED_DB $MAX_LINES
+        $RECONNECT_TIMER $STATUS_CACHE_MAXAGE $MAX_CACHED_STATUS $JOBS_COUNTDOWN
+        $ENABLE_SPLITTER $BACKEND_RETRY $BACKEND_RETRYTIMEOUT $AUTO_SPLIT_MAX
+        $DO_DB_OPTIMIZATION
+        );
+
+    # Add here to @SHARED some parameters only used in init script not to
+    # initialize
+    push @SHARED , qw(
+        $AFP2PRINT_USER $PERL $A2P_SYS_CONF $NICE $SERVICE_PROG $PRINTLIB_PATH
+        $TEXSPOOL
+        );
+
+    # Add shared to export list
+    push @EXPORT , @SHARED ;
+
+    @EXPORT_OK = qw( &UpdateSharedEnv &get_default_lockid );
+}
+our @SHARED ;
+our $SYSLOG ;
+our $SERVICE;
+
+# Defaults only used in bash scripts
+our $AFP2PRINT_USER = 'afp2print' ;
+our $PERL           = '/usr/bin/perl' ;
+our $NICE           = 'nice --5' ;
+our $SERVICE_PROG   = '$AFP2PRINT_PATH/a2p.pl' ;
+our $PRINTLIB_PATH  = '$AFP2PRINT_PATH/printlib' ;
+our $TEXSPOOL       = '' ;
+
+################################################################################
+##            Threads shared variables                                        ##
+##            Each one would be re-initialized by Init function as needed     ##
+################################################################################
+# DEV: When adding shared variable, dev lines must be added at:
+#   DEV1: its 'our' definition with eventually its default value
+#   DEV2: and also, it must be inserted in SHARED list (see BEGIN block)
+
+# DEV1
+
+# This is a constant to be update during rpm packaging
+sub A2P_RPM_VERSION () { '1.024' }
+
+# NO_LOGFILE is to be greater than 0 to output log to a file and to syslog
+# Default to 0 to not have logfile
+our $LOGFILE_VS_SYSLOG    = 0 ;
+our $LOGFILE_PURGE        = 0 ;
+our $LOGFILENAME          = "/var/log/a2p.debug" ;
+
+# NO_SYSLOG_DEBUG is to be greater than 0 to not send any Debug to syslog
+# Default to 0 to always debug service start (not critical)
+our $NO_SYSLOG_DEBUG      = 0 ;
+
+# SERVICE_DEBUG can be disabled to avoid debugging when service is shutting down
+our $SERVICE_DEBUG        = 1 ;
+
+# SYSLOG_PATH is the standard socket where to send syslog message to system
+our $SYSLOG_PATH          = "/dev/log" ; # Unix dfault
+our $STDOUT_DEBUG         = 0 ; # Send debug to standard console output if set
+our $DEBUG_IN_FILE        = 0 ; # To avoid sending debugging to syslog
+# ADVANCED_DEBUGGING should not be used in configuration but can be dynamically
+# be set by sending signal 12 (USR2) to a thread, see details in A2P::Signal
+our $ADVANCED_DEBUGGING   = 0 ; # To activate some online debugging
+
+# KEEP_DYNAMIC_JOB_LOG keeps job info that will be only available in the mail
+# sent to the ERRORS_MAIL list when an AlertError rises.
+our $KEEP_DYNAMIC_JOB_LOG = 1 ;
+# Set it to 0 to desactivate
+# Set it a greater value than 1 to also keep debugging messages
+
+our $JOB_DUMP_ON_ERROR    = 1 ; # By default make a job dump in the error mail
+our $JOIN_ZIP_ON_ERROR    = 1 ; # By default add zip when exist to dumped job
+
+# By default, we could keep some few last log messages,
+# used for job debugging on error and mailed report
+our $MAX_BACKLOG          = 10 ;
+
+# TeX info insertion enabled mostly for PDF Title and Creator
+our $ADDTEX_DOCINFO       = 1 ;
+
+# PCL5 info insertion can be forced for all produced PCL otherwise it should be
+# enabled by DESTID in desti configuration file
+our $ADDPCL_JOBNAME       = 0 ;
+our $ADDPCL_USERNAME      = 0 ;
+
+# TeX debugging for TeX validation only
+our $ADDTEX_DEBUG         = 0 ; # Set alone, it outputs font names in TeX output
+# ADDTEX_DEBUG must be true to use these following
+our $TEX_PAGEDEF_DEBUG    = 0 ; # Show PAGEDEF frame and page off-set used
+our $TEX_OVERLAY_DEBUG    = 0 ; # Show OVERLAY frames and page off-set used
+our $TEX_SEGMENT_DEBUG    = 0 ; # Show SEGMENT frames and page off-set used
+our $TEX_SHOW_SEGMENT     = 1 ; # Remove SEGMENT
+
+# Do we should start a logger thread
+our $START_LOGGER         = 1 ;
+
+# KEEP_STATS actives conversion statistics if set to 1
+our $KEEP_STATS           = 1 ;
+our $STATS_FOLDER         = "/apps/afp2print/stats" ;
+
+# KEEP_JOBSTATUS can be set to 0 to disable keeping job status
+our $KEEP_JOBSTATUS       = 1 ;
+
+# This is the max number of com to manage in one loop
+our $COM_BURST            = 5 ;
+# This set the use of locking feature during communication between processes
+# It can be imply a performance issue but also a stability issue if disabled
+our $COM_LOCKING          = 0 ; # Not useful with new comm scheme
+our $MAX_BUFFER_SIZE      = 65536 ;
+
+# DEBUG_MOD_LIST is to be populated with module or file name to not debug
+# DEBUG_SUB_LIST is to be populated with subfunction name to not debug
+# This comportement can be inversed by inserting the '!' char at beginning
+our $NODEBUG_MOD_LIST     = "" ;
+our $NODEBUG_SUB_LIST     = "" ;
+
+# DO_PINGPONG is to be greater than 0 to ping threads periodictly
+our $DO_PING              = 1 ;
+
+# AFPSPOOL is the spool directory where AFPDS file will be expected
+our $AFPSPOOL             = '/apps/afp2print/afpspool' ;
+
+# SCAN_SPOOL should be disabled for a validation service which don't need
+# to scan the spool. It will also disable SpoolManager launch.
+our $SCAN_SPOOL           = 1 ;
+# SPOOL_TIMER is the number of seconds between 2 checks in spool when idle
+our $SPOOL_TIMER          = 5 ;
+# SPOOL_PREFIX is to tune de prefix selection in the spool (NOT case sensitive)
+our $SPOOL_PREFIX         = "TRANS ARCHI" ;
+# WAIT_ON_PREFIX could be set to activate the wait on prefix locking
+our $WAIT_ON_PREFIX       = 0 ;
+
+# USLEEP is the time in microsecond to sleep in thread loops
+our $USLEEP               = 50000 ;
+# DYNAMIC_USLEEP set USLEEP to dynamic mode
+our $DYNAMIC_USLEEP       = 1 ;
+our $MAX_DYNAMIC_USLEEP   = 1_000_000 ; # Max USLEEP in dynamic mode (in ms)
+
+# CLEAN_OPTIMIZATION can be disable to force new job creation only after
+# previous jobs have been cleaned
+our $CLEAN_OPTIMIZATION   = 1 ;
+
+# This is the default project path installation
+our $AFP2PRINT_PATH       = '/apps/afp2print' ;
+
+# SHMDIR default to "/dev/shm" to optimize throughput as be done in memory
+our $SHMDIR               = '/dev/shm' ;
+
+# SERVICE_TMP is the path where to use temporary files
+our $SERVICE_TMP          = '/tmp/.a2p' ;
+
+# ERRORSPOOL is the spool directory where failed conversion files will be moved
+our $ERRORSPOOL           = '/apps/afp2print/spool/error' ;
+
+# DONESPOOL is the spool directory where done conversion files will be moved
+our $DONESPOOL            = '/apps/afp2print/spool/done' ;
+
+# LOGOPATH must point to the segment library
+our $LOGOPATH             = '/apps/afp2print/printlib/seglib' ;
+
+# MAXTASK is set to the number of concurrent conversion to process
+our $MAXTASK              = 1 ;
+
+# MAXJOBS is set to the maximum AFP jobs we can process at a time
+our $MAXJOBS              = 1 ;
+
+# MAXCONNECTIONS is the maximum concurrent connections that we be accepted by
+# any Listener
+our $MAXCONNECTIONS       = 10 ;
+
+# By default Listener won't listen on TCP/IP socket
+our $USE_TCPIP_SOCKET     = 0 ;
+our $USE_TCPIP_PORT       = 6400 ;
+# By default TCP/IP server will listen only on the localhost (127.0.0.1)
+our $USE_ONLY_LOOPBACK    = 1 ;
+# Even if listening over internet we only accept connection from just localhost
+# by default. Set it to "0.0.0.0" or "any" to accept from any host
+our $AUTHORIZED_HOST      = "127.0.0.1" ;
+
+# MAX_CONV_RATE is used to limit the conversion rate on big job. It is the
+# maximum number of conversion to do during one second, and it is really used
+# only with AFP job with more than this value of sub jobs
+# Default MAX_CONV_RATE=20 means AFP jobs with more than 20 sub-jobs will have
+# their TeX conversion limited to not exceed 20 sub-jobs created for each second
+# This should be used to avoid processes communication saturation
+# Remark: - if set to 0, conversion will slow down to reach one conversion by
+#           USLEEP interval
+#         - it is disabled with negative value
+our $MAX_CONV_RATE        = -1 ;
+
+# BACKEND_FACTOR must be greater than 0 and define the numbre of processes
+# (multiplied by MAXTASK) that will be used to call command on the system and
+# this defined also the number of ARchiver processes
+# Exemple:
+#  - If MAXTASK = 1 and BACKEND_FACTOR = 3 (this is the default)
+#        3 BackEnd processes will be managed
+#        3 Archiver will be also managed if ARCH_ENABLED is set
+#  - If MAXTASK = 2 and BACKEND_FACTOR = 5
+#        10 BackEnd processes will be managed
+#        10 Archiver will be also managed if ARCH_ENABLED is set
+our $BACKEND_FACTOR       = 3 ;
+# Maximum number of retries when command fails
+our $BACKEND_RETRY        = 10 ;
+# Maximum number of seconds when command fails to really set the command failed
+our $BACKEND_RETRYTIMEOUT = 30 ;
+
+# DESTIDFILE is the configuration file for print configuration
+our $DESTIDFILE           = '/etc/afp2print/destid.conf' ;
+
+# DOCSFILE is the configuration file for print correction by document
+our $DOCSFILE             = '/etc/afp2print/documents.conf' ;
+
+# DOCUMENTS_CORRECTION_ENABLED can be set to 1 to enable automatic by Documents
+# scaling and off-set correction. A flag by DestId can be used to enable/disable
+# the correction for a specific DestId.
+# When set greater than 1, the flag by DestId is ignored and correction is
+# forced and only if correction exists for a Document
+our $DOCUMENTS_CORRECTION_ENABLED = 0 ;
+
+# DONTZIPPDF must be set to '1' to keep PDF files not compressed in zip file
+# Only used if COMPRESSFILES is set to 1
+our $DONTZIPPDF           = 0 ;
+
+# DONT_PRINT is set to 1 to skip lpr command
+# FORCE_DESTID can be used as in validation, exemple set it to "LINDEC" in conf
+our $DONT_PRINT           = 0 ;
+our $FORCE_DESTID         = "" ;
+
+# AGREGATE_PRINT is set to 0 to force print immediatly and not agregate PCL5 to
+# only do one PCL5 by DESTID
+our $AGREGATE_PRINT       = 1 ;
+
+# PARALLELE_VALIDATION: Set it to:
+# - 1 to duplicate AFP incoming flux to validation mode and destinations
+# - 2 to only use validation mode and destination printers
+our $PARALLELE_VALIDATION = 0 ;
+
+# the dvilj variant to run taken from dvihp script
+our $DVILJ                = 'dvipcl5' ;
+
+# the zip option environment for optimizing compression
+our $ZIPOPTIONS           = 'DjJqXm' ;
+our $MAXFILES_BY_ZIPCMD   = 1 ;
+# COMPRESSFILES must be set to compression level desired for backup files in
+# DONESPOOL and ERRORSPOOL, value can be 0 to 9 (see 'zip' command man)
+our $COMPRESSFILES        = 0 ;
+
+# PURGEFILES is set to 1 when we don't need to keep any file after processing
+our $PURGEFILES           = 0 ;
+
+# MINFOLDERCOUNT is the minimum spool file number under which we will repopulate
+# the spool file cache
+our $MINFOLDERCOUNT       = 10 ;
+# MAXFOLDERCOUNT is the maximum spool files to keep in our known file cache
+our $MAXFOLDERCOUNT       = 100 ;
+# MAXRETRYTIMER is the time in ms to keep a cached available file
+# in memory before retrying to lock it
+our $MAXRETRYTIMER        = 500 ;
+
+# CONV_STATUS_TIMING is the time in second after which a status conversion must
+# be provided to inform clients
+our $CONV_STATUS_TIMING   = 30 ;
+
+# KEEP_AFPJOB is set to 1 when PARALLELE_VALIDATION is 0 if we want to keep AFP
+# version of each job. In that case, an AFPDS file is splitted in as many job
+# that it contains. This is the default if PARALLELE_VALIDATION is set to 1 or 2
+our $KEEP_AFPJOB          = 1 ;
+
+# Mailing variables for alerts and errors
+our $MAIL_BIN             = "/usr/lib/sendmail" ;
+# ALERT_MAILS will receive a short mail with only job in ABTERM in the subject
+our $ALERT_MAILS          = "" ;
+# ERROR_MAILS will receive a mail with knowns errors in the body
+our $ERROR_MAILS          = "" ;
+
+# CLient time-out is the max time we can expect for a response from listener
+our $CLIENT_TIMEOUT       = 300 ;
+
+# Some variable used for archivage processing
+our $ARCH_REMHOST_TEST    = '127.0.0.1' ;
+our $ARCH_REMPORT_TEST    = 2222 ;
+our $ARCH_REMHOST_TLOG    = '127.0.0.1' ;
+our $ARCH_REMPORT_TLOG    = 2222 ;
+our $ARCH_REMHOST_PROD    = '127.0.0.1' ;
+our $ARCH_REMPORT_PROD    = 2222 ;
+our $ARCH_DEBUG           = 0 ;
+# ARCH_ENABLED: Can be set to from 0 to 99
+#               to get ARCH_ENABLED * BACKEND_FACTOR Archiver processes
+# ARCH_ENABLED: Set to greater than 99 to activate an archivage simulation:
+#    - if = 100 than archivage call returns true each time
+#    - else greater, it returns randomly false when random(value) > 99
+#      (so greater value produces more false case)
+our $ARCH_ENABLED         = 2 ;
+# ARCH_SCENARIO: 1 = separate binary file, 3 = xml embedded
+our $ARCH_SCENARIO        = 1 ;
+
+# ESERVICE designs Electronic Service it can only be activated with AFP flux
+# telling about RC 200,201,202 and replaces the ARCH step when enabled
+our $ESERVICE_ENABLED     = 0 ;
+# ESERVICE_ENABLED: Can be set to from 0 to 99
+#                   to get ESERVICE_ENABLED * BACKEND_FACTOR EService processes
+# ESERVICE_ENABLED: Set to greater than 99 to activate an e-service simulation:
+#    - if = 100 than e-service call returns true each time
+#    - else greater, it returns randomly false when random(value) > 99
+#      (so greater value produces more false case)
+our $ESERVICE_CONF        = '/etc/afp2print/e-service.conf' ;
+
+# By default client request sockets are closed when processed
+our $CLOSE_CONNECTIONS    = 1 ;
+
+# CONVERT_CONTENT_FILE must be true to convert RC201-RC202 content from EBCDIC
+our $CONVERT_CONTENT_FILE = 1 ;
+
+# DO_CONVERT is set or not to activate AFP conversion with from_to perl API
+our $DO_CONVERT           = 1 ;
+# The following defines which encoding to use with from_to perl API
+our $FROM_CONVERT         = 'cp1047' ;
+our $TO_CONVERT           = 'latin1' ;
+
+# ENABLE_DTD_VALIDATION can be set to 0 or 1 to disable
+# or activate DTD validation on XML requests
+our $ENABLE_DTD_VALIDATION= 0 ;
+
+# ONLY_DO_PDF can be set to avoid the steps 4 to 10 only used with printing and
+# online archivage. This is used essentialy to only handle PDF generation and
+# get better performance in this case.
+our $ONLY_DO_PDF          = 0 ;
+
+# DBI variables with default connection on local mysql serveur and db a2p
+our $DBI_DSN              = 'DBI:mysql:database=a2p;host=localhost;port=3306' ;
+our $DBI_USER             = '' ; # Set to Progname (a2p-stat,...) if not set
+our $DBI_PASSWD           = '' ; # Connection should failed if not configured
+
+# Time to force reconnection to DB for a2p-stat and a2p-status services
+our $RECONNECT_TIMER      = 3600 ;
+
+# A2PDB_PREFIX can be set if you need to install stats or/and status tables in
+# a database with conflicting table names
+our $A2PDB_TABLE_PREFIX   = '' ;
+
+# Set maximum amount of values that can be cached in memory during DB usage
+our $MAX_CACHED_DB        = 10000 ;
+# Set maximum lines to read by a2p-stat in each statistics file at each loop
+our $MAX_LINES            = 100 ;
+
+# By default don't do DBA job by ourself
+our $DO_DB_OPTIMIZATION   = 0 ;
+
+# STATSFILE_MAXAGE is only used by statistics service to delete statistics file
+# for which the age in DAYs is greater than this value
+our $STATSFILE_MAXAGE     = 70 ;
+# Default value keeps at least 2 months of statistics files
+
+# STATUS_MAXAGE is used as peremption timer for status information in DBM files
+# By default it should be disabled, and only activated in a2p-status service
+# Only DONE status can be deleted automatically as it is redondant
+# with statistics informations. Unit is milli-second.
+our $STATUS_MAXAGE        = 3600000 ; # Clean after one hour
+# But we are checking Progname later below and set it to 1h on *-status name
+our $STATUS_CACHE_MAXAGE  = 60000 ; # 1 minute
+# Default value keeps 1 hour of status
+# MAX_CACHED_STATUS set the max number of status we can keep in cache. If this
+# maximum is reached, the older DONE status will be released
+our $MAX_CACHED_STATUS    = 1000 ;
+# STATUS_DB_MAXAGE represents the max time to keep a status in jobs_status table
+our $STATUS_DB_MAXAGE     = 24 ; # Time in hours
+
+# A boolean to enable/disable the AFPDS splitting code
+our $ENABLE_SPLITTER      = 1 ;
+# A number of jobs on which use an auto-split
+our $AUTO_SPLIT_MAX       = 100 ;
+
+# A value to force a2p to quit when this number of jobs has been processed
+our $JOBS_COUNTDOWN       = 0 ;
+
+# STATS_COMMIT_SKIP is only used by statistics to skip some commit, when loading
+# statistics files to get better performance
+our $STATS_COMMIT_SKIP    = 100 ;
+# But commit will be forced if none has been done since 10 seconds
+
+# GIFTOPCL is the command chain to use for GIF to PCL conversion
+# The first %d will be replaced by the width of the image to scale to
+# The second %d will be replaced by the resolution to be used for PCL format
+our $GIFTOPCL             = 'giftopnm | pnmscalefixed -width=%d | ppmtopgm ' .
+    '| pgmtopbm -d8 | pbmtolj -resolution %d -packbits -float -noreset' ;
+# Dont't use delta compression with pbmtolj as the result is wrong with texts
+
+# PNGCOMPRESSION could be from 0 for no compression to 9 for maximum compression
+# of included PNG resources in PDF generated files
+our $PNGCOMPRESSION       = 9 ;
+
+# PCL_RESOLUTION is the default resolution to use for PCL resource conversion
+our $PCL_RESOLUTION       = 600 ;
+
+# LOCKID is just an identifier to be able to run the service on the same spool
+our $LOCKID               = &get_default_lockid() ;
+
+sub get_default_lockid {
+    my $lockid = "a2p-service" ;
+    if ( -e '/proc/sys/kernel/hostname' and ! $SERVICE ) {
+        open *HOSTNAME , '<', "/proc/sys/kernel/hostname"
+            or die "Can't read hostname from kernel: $!";
+        $lockid = <HOSTNAME> ;
+        close HOSTNAME ;
+    } else {
+        $lockid = $SERVICE ? $ENV{'LOCKID'} : qx/hostname -s/ ;
+    }
+    chomp $lockid ;
+    $lockid = $1 if ( $lockid =~ /^([^.]+)/ );
+    $lockid = uc( $lockid );
+    return $lockid ;
+}
+
+our $MUSTQUIT             = 0 ; # Shared flagged to stop immediatly
+
+# Should we use \special command specific to dvipcl5 instead of
+# Integrating files containing PCL5 commands
+our $USE_PCLCMD           = 1 ;
+
+################################################################################
+##                      Optimized shared constants                            ##
+################################################################################
+# These common constants are arbitrary values
+sub QUIT       () { 0xEFEF }; # Constant passed in request queues
+sub PING       () { 0x0FF0 }; # Constant passed to ping a thread
+sub _INIT      () { 0xF000 }; # Constant passed to update thread env
+sub _UPDATE    () { 0xF001 }; # Constant passed to directly update shared var
+sub TODO       () { 0x8888 }; # Constant passed to ask job to a thread
+sub DONE       () { 0xFFF0 }; # Constant to say job is done
+sub NOMOREFILE () {   99   }; # Constant to say when no file are found in spool
+
+our %means = (
+    QUIT        ,   "QUIT",
+    PING        ,   "PING",
+    _INIT       ,   "INIT",
+    _UPDATE     ,   "Direct UPDATE",
+    TODO        ,   "TODO",
+    DONE        ,   "DONE",
+    NOMOREFILE  ,   "NO MORE FILE"
+    );
+
+# Regex used in SpoolManager and Converter to compute AFPNAME
+our $AFPNAME_REGEX =
+    qr/(?i:LINUX\.|TEMP\.)*([-0-9a-zA-Z_.]+)(?i:\.afp|\.afpds)?$/ ;
+
+################################################################################
+##                            System shared values                            ##
+################################################################################
+# Prepare process short name, extracting basename without extension
+our $Progname ;
+if (!defined($Progname)) {
+    ( $Progname ) = $ARGV[0] =~ m|.*/([^/.]+)(\.[^/.]+)?$|
+        if (defined($ARGV[0]));
+    ( $Progname ) = $0 =~ m|.*/([^/.]+)(\.[^/.]+)?$|
+        unless (defined($Progname));
+    $Progname = "a2p" unless (defined($Progname));
+}
+
+die "Can't starting process without Progname defined"
+    unless (defined($Progname));
+
+our $maintid = 0 ;
+our $do_file = 0 ;
+our %STATS  = () ;
+our @AbortTime = () ;
+
+sub DOWNSTAT {
+    my $what = shift ;
+    my $down = @_ ? shift : 1 ;
+    unless (defined($STATS{$what})) { $STATS{$what} = 0 }
+    $STATS{$what} -= $down ;
+}
+
+sub UPSTAT {
+    my $what = shift ;
+    my $plus = @_ ? shift : 1 ;
+    unless (defined($STATS{$what})) { $STATS{$what} = 0 }
+    $STATS{$what} += $plus ;
+}
+
+my %chrono = () ;
+sub TIMESTAT {
+    my @timing = &gettimeofday() ;
+    my $what = 'TIMING-' . $_[0] ;
+    if (defined($chrono{$what}) and @{$chrono{$what}}) {
+        &MAXSTAT($what,( $timing[0] - ${$chrono{$what}}[0] ) * 1_000_000
+            + ( $timing[1] - ${$chrono{$what}}[1] ));
+        $chrono{$what} = [] ;
+
+    } else {
+        $chrono{$what} = [ @timing ] ;
+    }
+}
+
+sub MAXSTAT {
+    my $max = $_[0] . '-MAX' ;
+    $STATS{(!defined($STATS{$max}) or $_[1] > $STATS{$max}) ? $max : $_[0]}
+        = $_[1] ;
+}
+
+sub MAXMINSTAT {
+    my $min = $_[0] . '-MIN' ;
+    $STATS{(!defined($STATS{$min}) or ! $STATS{$min}
+        or ( $_[1] and $_[1] < $STATS{$min})) ? $min : $_[0]} = $_[1]
+        if (&MAXSTAT(@_) == $_[1]);
+}
+
+# Update LOGFILENAME default
+$LOGFILENAME = $SHMDIR . '/' . $Progname . '.log' unless $LOGFILENAME ;
+
+our $LISTENER = $SERVICE_TMP . '/' . $Progname . '-listener' ;
+
+# This authorizes to get thread compilation errors when debugging
+our $StdoutFile = "/var/run/$Progname.debug" ;
+# But it should be really set to /dev/null for a service
+$StdoutFile = "/dev/null" if ( ! -e $StdoutFile );
+
+# A2P_SYS_CONF has its defaults should come from a2p.sh script
+our $A2P_SYS_CONF = defined($ENV{'A2P_SYS_CONF'}) ?
+    $ENV{'A2P_SYS_CONF'} : "/etc/afp2print/afpds2tex.conf" ;
+
+if ($SERVICE) {
+    # Initialize Init module
+    &Init( "$A2P_SYS_CONF" , "/etc/afp2print/" . $Progname . ".conf" );
+
+    my @FIRSTENV = &Init( map { $_ => eval $_ } @SHARED );
+
+    # Now we can evaluate our %ENV
+    map { eval $_ } @FIRSTENV ;
+
+    my $debugenv = 0 ; # Set to one to got ENV debugging while updating conf
+    sub UpdateSharedEnv {
+        # Compute shared variable
+        map {
+            my ( $key ) = $_ =~ /^[\$](.*)$/ ;
+            if ($key and defined($ENV{$key})) {
+                my $quote = $ENV{$key} =~ /^\d+$/ ? "\"\"" : "\"'\"" ;
+                eval "$_ = \$ENV{$key}" ;
+            }
+        } @SHARED ;
+
+        # Update some other ENV
+        $ENV{TEXMFOUTPUT} = $SHMDIR if ( defined($SHMDIR) and -d $SHMDIR );
+
+        # Debug env if needed
+        if ($debugenv) {
+            my %HASH = %ENV ;
+            $debugenv ++ while ( -e "/tmp/$Progname-ENV-$debugenv" );
+            open( *LOG, '>', "/tmp/$Progname-ENV-$debugenv" )
+                or return ;
+            map {
+                my ( $key ) = $_ =~ /^[\$](.*)$/ ;
+                print LOG scalar(localtime), ", $0: $_ => ",
+                    defined($ENV{$key}) ? "ENV='$ENV{$key}'" : "ENV=undef",
+                    " vs '", eval $_ , "'\n" ;
+                delete $HASH{$key};
+            } @SHARED ;
+            map {
+                print LOG scalar(localtime), ", $0: ENV $_ = $ENV{$_}\n"
+                } keys( %HASH );
+            map {
+                print LOG scalar(localtime), ", $0: FIRSTENV => $_ \n"
+                } @FIRSTENV ;
+            close(LOG);
+        }
+    }
+
+    &UpdateSharedEnv ;
+}
+
+1;
Index: /A2P/a2p/A2P/Infos.pm
===================================================================
--- /A2P/a2p/A2P/Infos.pm	(revision 3)
+++ /A2P/a2p/A2P/Infos.pm	(revision 3)
@@ -0,0 +1,266 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Class to report any usefull information
+#
+
+package A2P::Infos ;
+
+use strict;
+use A2P::Globals ;
+use A2P::Globals qw( get_default_lockid );
+use A2P::Syslog ;
+use A2P::Init ;
+use A2P::Init qw( ResetInit );
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 1185 $ =~ /(\d[0-9.]+)\s+/ ;
+}
+our $VERSION ;
+
+sub new {
+    my $class  = shift ;
+    my $self = {
+       LOCKID_LIST  => []
+       } ;
+    bless $self , $class ;
+    &Debug("new ".__PACKAGE__." object v$VERSION created");
+    return $self ;
+}
+
+my $default_lockid = &get_default_lockid() ;
+my $config ;
+
+sub _get_local_servicename {
+    my $lockid = shift ;
+    my $service = shift ;
+
+    my @confs ;
+    my @found = () ;
+
+    # If one more argument, it's directly the local service name
+    if (defined($service)) {
+        @confs = ( '/etc/afp2print/' . $service . '.conf' ) ;
+
+    } else {
+        # Get all local configuration files
+        @confs = glob( '/etc/afp2print/*.conf' ) ;
+    }
+
+    foreach my $conf (@confs) {
+        my ( $name ) = $conf =~ m|^/etc/afp2print/([^/]+)\.conf$| ;
+        # Skip other configurations
+        next if ( $name =~ /^destid|documents|afpds2tex|stat|e-service/ );
+
+        &Debug("Checking '$conf' configuration") if ($ADVANCED_DEBUGGING);
+
+        # Initialize Init module
+        &ResetInit ;
+        &Init( "$A2P_SYS_CONF" , $conf );
+
+        # Requested values must be specified here
+        my @env = &Init(
+            '$TEXSPOOL'       => '',
+            '$AFPSPOOL'       => '',
+            '$ERRORSPOOL'     => '',
+            '$DONESPOOL'      => '',
+            '$LOCKID'         => $default_lockid,
+            '$SCAN_SPOOL'     => 0,
+            '$KEEP_JOBSTATUS' => 0
+            );
+        my %env = () ;
+        foreach my $env ( @env ) {
+            $env =~ s|ENV\{(\w+)\}|env{$1}| ;
+            eval $env ;
+        }
+
+        next unless ( $env{LOCKID} eq $lockid
+            and $env{SCAN_SPOOL} and $env{KEEP_JOBSTATUS});
+
+        &Debug("Service '$name' uses '$env{LOCKID}' LOCKID")
+             if ($ADVANCED_DEBUGGING);
+
+        # Keep config for other API
+        $config = \%env ;
+
+        push @found, $name ;
+    }
+
+    return @found ;
+}
+
+sub _recursive_serviceid_table_check {
+    my $ref = shift ;
+    my $depth = shift || 0 ;
+    return &Error("Not a hash ref at depth $depth in services id list")
+        unless (ref($ref) =~ /^HASH/);
+    if ($depth<2) {
+        map {
+            unless(&_recursive_serviceid_table_check($ref->{$_},$depth+1)) {
+            delete $ref->{$_} ;
+            &Error("Key '$_' deleted at depth $depth in services id list");
+            }
+        } keys(%{$ref}) ;
+
+    } elsif (!exists($ref->{serviceid}) or !defined($ref->{serviceid})
+        or !$ref->{serviceid}) {
+            return &Error("'serviceid' key not found");
+    }
+    return scalar(keys(%{$ref})) ;
+}
+
+sub get_lockid_list {
+    return @{$_[0]->{LOCKID_LIST}} ;
+}
+
+sub get_serviceid_of {
+    my $self = shift ;
+    my $object = shift ;
+
+    my $lockids = $self->{LOCKID} ;
+    $lockids = $self->{LOCKID} = {} unless (defined($lockids));
+
+    # Services table is transmitted by A2P::DB as hash to initialize our list
+    if (ref($object) =~ /^HASH/) {
+        if (&_recursive_serviceid_table_check($object)) {
+            my @services = () ;
+            $self->{LOCKID_ERROR} = 0 ;
+
+            # Scan hash to get any (lockid,serviceid) pair
+            foreach my $name (keys(%{$object})) {
+                foreach my $lockid (keys(%{$object->{$name}})) {
+                    my $serviceid =
+                        exists($object->{$name}->{$lockid}->{serviceid})
+                        ?
+                        $object->{$name}->{$lockid}->{serviceid}
+                        :
+                        &Error("No serviceid found for '$name-$lockid'")
+                        ;
+                    #&Debug("Keeping serviceid $serviceid for '$name-$lockid'");
+                    push @services, [ $lockid , $serviceid , $name ] ;
+                }
+            }
+
+            # Scan each pair to get conflicting ones
+            while (@services) {
+                my ( $lockid, $serviceid, $name ) = @{ shift @services } ;
+                my @match = () ;
+                if (@match = grep { $_->[0] eq $lockid } @services) {
+                    &Debug("Found services with same LOCKID for this server");
+
+                    # 0. Still strip conflicting from list
+                    @services = grep { $_->[0] ne $lockid } @services ;
+
+                    # 1. Search available LOCKID in local configurations
+                    my @localname = &_get_local_servicename($lockid);
+                    if (!@localname) {
+                        &Debug("No local service with $lockid LOCKID found, skipping it");
+                        next ;
+
+                    } elsif (@localname == 1 and $localname[0] eq $name) {
+                        # This lockid is in fact the only one used today, so
+                        # just remove the others
+                        &Debug("Found '$lockid' is managed by service '$name'");
+
+                    } elsif (@localname == 1) {
+                        # Only local service really use this lockid but it should
+                        # be in @match others list
+                        my @realone = grep { $_->[2] eq $localname[0] } @match ;
+                        &Debug("Not installed locally"),next unless (@realone);
+                        &Debug("Found '$lockid' is managed by service '$localname[0]'");
+                        &Warn("Found many local service '$name-$lockid', please update your confs")
+                            if (@realone>1);
+                        ( $lockid, $serviceid, $name ) = @{$realone[0]} ;
+
+                    } else {
+                        # Found many local running service with the same LOCKID, we need to
+                        # say something is bad in configurations
+                        &Warn("Bad server configuration found: ".
+                            "many service seems to have the same LOCKID",
+                            "So I will associating serviceid $serviceid to only service $name",
+                            "You should check configuration files, and set different LOCKID for each one",
+                            map { "'$_' service configuration is to check"} @localname
+                            );
+                    }
+                }
+
+                if ( ! defined($lockids->{$lockid}) or
+                    $lockids->{$lockid} != $serviceid ) {
+                    &Debug("Setting serviceid to $serviceid for lockid $lockid as service $name");
+                    $lockids->{$lockid} = $serviceid ;
+                }
+            }
+
+            # Update lockid list
+            $self->{LOCKID_LIST} = [ keys(%{$lockids}) ] ;
+
+            # And return ourself
+            return $self ;
+
+        } else {
+            return &Error("No serviceid table found in '$object'");
+        }
+
+    }
+
+    return (defined($lockids->{$object}) and $lockids->{$object}) ?
+        $lockids->{$object} : 0 ;
+}
+
+sub get_servicename_of {
+    my $self = shift ;
+    my @name = &_get_local_servicename(@_) ;
+    my $name = shift @name ;
+    return '' unless ( defined($name) and $name );
+    #&Debug("Servicename of '@_' is '$name'");
+    return $name ;
+}
+
+sub get_afpspool_of {
+    my $self = shift ;
+    my $lockid = shift ;
+    my $service = shift || 'afpds2tex' ;
+    my @name = &_get_local_servicename($lockid,$service) ;
+    my $name = shift @name ;
+    return &Error("No conf found for $service service (Got '$name')")
+        unless ( $name eq $service );
+    #&Debug("Servicename of '@_' is '$name'");
+    return exists($config->{'AFPSPOOL'}) ? $config->{'AFPSPOOL'} :
+        &Error("AFPSPOOL not found for $service service") ;
+}
+
+sub get_spools_of {
+    my $self = shift ;
+    my $lockid = shift ;
+    my $service = shift || 'afpds2tex' ;
+    my @name = &_get_local_servicename($lockid,$service) ;
+    my $name = shift @name ;
+    return &Error("No conf found for $service service (Got '$name')")
+        unless ( $name eq $service );
+    #&Debug("Servicename of '@_' is '$name'");
+    return map { exists($config->{$_}) ? $config->{$_} : '' }
+        qw( DONESPOOL ERRORSPOOL ) ;
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
+
Index: /A2P/a2p/A2P/Init.pm
===================================================================
--- /A2P/a2p/A2P/Init.pm	(revision 3)
+++ /A2P/a2p/A2P/Init.pm	(revision 3)
@@ -0,0 +1,139 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+package A2P::Init;
+
+use strict ;
+use integer ;
+
+BEGIN {
+    use Exporter ();
+
+    our ( $VERSION , @ISA , @EXPORT , @EXPORT_OK );
+
+    $VERSION = sprintf "%s", q$Rev: 415 $ =~ /(\d[0-9.]+)\s+/ ;
+
+    @ISA = qw(Exporter);
+    @EXPORT = qw( &Init );
+    @EXPORT_OK = qw( &ResetInit );
+}
+our $VERSION ;
+
+my @Shareds   = () ;
+my @ConfFiles = () ;
+my %CONF      = () ;
+
+#############################################################################
+##          Init code  -  Also called when receiving a HUP signal          ##
+#############################################################################
+sub Init {
+    return unless @Shareds or @_ ;
+
+    # First call should initialize our ConfFiles list
+    return @ConfFiles = @_ if ( ! @ConfFiles and @_ );
+
+    # We have to (re-)read our system conf
+    my %Updated = () ;
+
+    # Second call should initialize our SHARED and defaults list
+    if ( ! %CONF and @_ ) {
+        %CONF = @_ ;
+        @Shareds = keys(%CONF);
+
+        map {
+            my ( $strippedkey ) = $_ =~ /^[\$](.*)$/ ;
+            $Updated{$_} = $strippedkey ;
+        } @Shareds ;
+    }
+
+    # Next calls will update our conf
+
+    foreach my $ConfFile ( @ConfFiles ) {
+        next if ( ! -e $ConfFile );
+
+        # Open the file for reading and scan each line for standard shell definition
+        if (! open( *CONF , '<', $ConfFile )) {
+            warn "Can't open '$ConfFile' for reading" ;
+            next ;
+        }
+
+        my @lines = (<CONF>);
+        close(CONF);
+
+        @lines = grep { $_ !~ /^\s*#/ } @lines ; # Strip comments
+        @lines = grep { /=/ } @lines ; # Keep only variable definition
+
+        foreach my $key ( @Shareds ) { # Not optimized but rarely called
+            my ( $strippedkey ) = $key =~ /^[\$](.*)$/ ;
+
+            # There should be only one line
+            foreach my $def ( grep { /^$strippedkey=/ } @lines ) {
+                chomp $def ;
+                #&debugdev("Analysing $def from $ConfFile conf...");
+                my ( $value ) = $def =~/^$strippedkey=\s*["']?([^"']*)["']?\s*$/;
+                if ( ! defined($value) ) {
+                    warn "Bad configuration line found for '$strippedkey' var: '$def' in '$ConfFile' file" ;
+                    next ;
+                }
+                $value = $1 if ( $value =~ m|^(.*)/$| ); # Strip / from folders
+                if ( $CONF{$key} ne $value ) {
+                    $CONF{$key} = $value ;
+                    #&debugdev("Updating $key to $value");
+                    $Updated{$key} = $strippedkey ;
+                }
+            }
+        }
+    }
+
+    # Get vars that are eventually defined with shell expansion
+    my @needshellexpansion = grep { $CONF{$_} =~ /[\$]/ } @Shareds ;
+
+    # Does expansion if needed
+    foreach my $var ( @needshellexpansion ) {
+        #&debugdev("$var has shell expansion: $CONF{$var}");
+        my $limitrecursion = 10 ;
+        my $temp = "" ;
+        while ( $limitrecursion and $CONF{$var} =~ /[\$]/ ) {
+            $limitrecursion -- ;
+            foreach my $key ( @Shareds ) {
+                my ( $strippedkey ) = $key =~ /^[\$](.*)$/ ;
+                next unless $CONF{$var} =~ m|$strippedkey| ;
+                #&debugdev("$var has shell expansion with $key=$CONF{$key}");
+                $CONF{$var} =~ s|[\$]$strippedkey|$CONF{$key}| ;
+            }
+        }
+    }
+
+    # Returns %ENV string list to evaluate
+    return map {
+        my $chr = $CONF{$_} =~ /^\d+$/ ? "" : "'" ;
+        '$ENV{' . $Updated{$_} . '} = ' . $chr . $CONF{$_} . $chr ;
+        } keys(%Updated) ;
+}
+
+sub ResetInit {
+    @Shareds   = () ;
+    @ConfFiles = () ;
+    %CONF      = () ;
+}
+
+1;
Index: /A2P/a2p/A2P/Job.pm
===================================================================
--- /A2P/a2p/A2P/Job.pm	(revision 3)
+++ /A2P/a2p/A2P/Job.pm	(revision 3)
@@ -0,0 +1,2096 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Class to implement job object to be tramsmitted between threads
+#
+
+package A2P::Job;
+
+use strict;
+use A2P::Globals ;
+use A2P::Syslog;
+use AFPDS::PCL;
+use Time::HiRes  qw( time gettimeofday tv_interval );
+use A2P::Com   qw( GetCom comJOB comZIP comFILE );
+use A2P::Tools qw( ShortID );
+use A2P::Syslog 'AttachZipToAlertError' ;
+use A2P::JobStatus 'a2pjobstate' ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 1180 $ =~ /(\d[0-9.]+)\s+/ ;
+}
+our $VERSION ;
+
+my %uniqid = () ;
+
+sub new {
+    my $class  = shift ;
+    my $time = time ; # time is here the Time::HiRes 'time' version
+    my @Date = localtime($time);
+    my $DayTick = ($time - int($time -
+        ( $Date[0] + $Date[1]*60 + $Date[2]*3600 ))) * 193 ;
+
+    my $self = {
+        ERROR   => 0    ,   STEP        => 0        ,   JOBS        => 0    ,
+        START   => time ,   FILE        => ""       ,   STATE       => 0    ,
+        A2PJOB  => ""   ,   PURGE       => 0        ,   PURGETRYOUT => 10   ,
+        JOBDIR  => ""   ,   CANPURGE    => undef    ,   MOVE_CMDS   => undef,
+        ALERTED => undef,   ANSWER      => ""       ,   ERRORS      => []   ,
+                            SEQREADY    => 0        ,   CLIENTREF   => 0    ,
+        NB_CMDS => 0    ,   FILE2MOVE   => 0        , NB_CMDS_CHECK => 0    ,
+        STEPDONE=> 0    ,   NB_CMDS_UNIT=> 0        ,   SEQREMOVED  => 0    ,
+        BIRTH   => time ,   JOBDIR      => "undefined",
+        API_REV	=> "a2p v".A2P_RPM_VERSION." (".__PACKAGE__." v$VERSION)"
+    };
+    @{$self->{DELETE}} = () ; # List of files to delete without checking them
+    @{$self->{CLEAN}}  = () ; # List of files to check and keep if not empty
+    @{$self->{PDFS}}   = () ; # List of generated PDF files
+    @{$self->{MOVE}}   = () ; # List of files to move
+    @{$self->{INFO}}   = () ; # Keep some info until they are useful
+    $self->{KEEP_INFO} = {} ; # Keep some info for KEEP_DYNAMIC_JOB_LOG option
+    $self->{TIMED_INFO}= [] ;
+    $self->{CLONES}    = [] ; # List of clones as indexed list
+
+    # Initializes print sequence
+    %{$self->{SEQUENCE}} = () ;
+    %{$self->{LPRSEQ}}   = () ;
+    %{$self->{VLPRSEQ}}  = () ;
+
+    # Construct an ID for that job with :
+    # - 1 char for the year: A -> 2005, B -> 2006, etc...
+    # - 3 digits for the year day : 001 to 365
+    # - 1 '-' separator char
+    # - 6 hex digits for a time since midnigh (in ~ 1/193 of sec or ~5.2 ms)
+    # - 1 '-' separator char
+    # - 4 chars to keep a short human friendly identifier
+    if ( @_ ) {
+        $self->{ID}         = shift ;
+        $self->{CLIENTREF}  = shift ;
+        $self->{CLIENTINFO} = [ ] ;
+        # We must check if job is still running before starting it again
+        if (defined($uniqid{$self->{ID}})) {
+            &Warn("Aborting attempt to restart $self->{ID} running job");
+            return 0 ;
+        }
+
+    } else {
+        my $retries = 100 ; # Paranoid just in case
+        my $baseid = sprintf("%c%03D-%06X-", $Date[5]-40 , $Date[7] , $DayTick);
+        my $nameid = '' ;
+        while ((! $nameid or defined($uniqid{$baseid.$nameid})) and $retries ) {
+            $nameid = &ShortID ;
+            $retries -- ;
+        }
+        $self->{ID} = $baseid . $nameid ;
+    }
+
+    # Set uniqueness information
+    $uniqid{$self->{ID}} = 1 ;
+
+    &Debug("new Job object v$VERSION created with ID=" . $self->{ID} .
+        ( $self->{CLIENTREF} ? " for " . $self->{CLIENTREF} : "" ));
+    return bless $self , $class ;
+}
+
+sub newjob {
+    &TIMESTAT('NEW_JOB');
+    my $self  = shift ;
+    my $class = ref($self);
+    my %clone = %{$self} ;
+    my $clone = bless \%clone , $class ;
+
+    # Be sure to not resplit again
+    delete $clone->{'SPLIT_FILE'} if ($self->is_splitted());
+
+    # Compute environment calculated by ControlRecord.pm and given as answer
+    # conversion
+    map {
+        my ( $key , $value );
+        eval q|$clone->{| . $key . q|} = | .
+            ( $value =~ /^\d+$/ ? $value : qq|'$value'| )
+            if ( ( $key , $value ) = m|<env *key=["']?(\w+)["']? *>(.*)$|i )
+    } split( '</env>' , $self->getanswer );
+
+    # Handle split event for JobManager to do the job
+    if (exists($clone->{'SPLIT_FILE'})) {
+        $self->{'SPLIT_TAG'}   = $clone->{'SPLIT_TAG'} ;
+        $self->{'SPLIT_TAG2'}  = $clone->{'SPLIT_TAG2'} ;
+        my ( $prevpos , $nextpos ) = $clone->{'SPLIT_FILE'} =~ /^(\d+):(\d+)$/ ;
+        $self->{'SPLIT_FILE'}  = $nextpos ;
+
+        # Count original AFP with split events
+        &UPSTAT('SPLITTED_AFP') unless ($prevpos);
+
+        # Defined the trigger for the splitter command
+        $self->{'SPLIT_TRIGGER'} = 1 ;
+
+        # Reset step status
+        $self->setanswer('');
+
+        # Save the splitted file at the split only
+        ( $self->{'SPLITTED_FILE'} ) = $self->{'FILE'} =~ m|$LOCKID/[^/]*$| ?
+            $self->{'FILE'} =~ m|($LOCKID/[^/]*)$|
+            :
+            $self->{'FILE'} =~ m|([^/]*)$|
+            unless (defined($self->{'SPLITTED_FILE'})) ;
+
+        my $count_format = '%02d' ;
+
+        # Save tags list and control last one was not used before
+        if (defined($self->{'SPLIT_TAGS'})) {
+            # Control case where TAG are identical (as in auto-split)
+            if ( $self->{'SPLIT_TAG'} eq $self->{'SPLIT_TAG2'} ) {
+                my $count = scalar(keys(%{$self->{'SPLIT_TAGS'}})) ;
+                $self->{'SPLIT_TAG2'} .= sprintf( $count_format, $count ) ;
+            }
+
+            # Replace TAG in case it was previously updated
+            $self->{'SPLIT_TAG'} = $self->{'SPLIT_TAGS'}->{$prevpos}
+                if (exists($self->{'SPLIT_TAGS'}->{$prevpos}));
+
+            # Control TAG2 has not still been set
+            my @tags = values(%{$self->{'SPLIT_TAGS'}}) ;
+            my ( $tag, $ctrl, $iter ) = ( $self->{'SPLIT_TAG2'}, 2, 0 ) ;
+            while ( grep { /^$tag$/ } @tags ) {
+                $tag = $self->{'SPLIT_TAG2'} . '.' . &ShortID($ctrl) ;
+                $ctrl += 2 unless ( ++$iter % 100 );
+            }
+            # Save uniq tag
+            $self->{'SPLIT_TAGS'}->{$nextpos} = $self->{'SPLIT_TAG2'} = $tag ;
+
+        } else {
+            # Control case where TAG are identical (as in auto-split)
+            if ( $self->{'SPLIT_TAG'} eq $self->{'SPLIT_TAG2'} ) {
+                $self->{'SPLIT_TAG'}  .= sprintf( $count_format, 0 ) ;
+                $self->{'SPLIT_TAG2'} .= sprintf( $count_format, 1 ) ;
+            }
+
+            # Initialize known tags list
+            $self->{'SPLIT_TAGS'} = {
+                 $prevpos => $self->{'SPLIT_TAG'},
+                 $nextpos => $self->{'SPLIT_TAG2'}
+                } ;
+
+            # We should also link on AFP name for the first splitted status
+            my $newafp = $self->{'AFPNAME'} . '.' . $self->{'SPLIT_TAG'} ;
+            $self->jobstatus( 'o', {
+                LINKEDAFP => $self->{'AFPNAME'},
+                AFP       => $newafp
+            } )
+                or &Info("Can't initialize '$newafp' status");
+        }
+
+        &TIMESTAT('NEW_JOB');
+        return undef ;
+    }
+
+    &UPSTAT('NEW_JOB');
+
+    # Keep AFPNAME only on A2P job on the first sub job
+    $self->{'AFPNAME'} = $clone->{'AFPNAME'}
+        unless (exists($self->{'AFPNAME'}));
+    delete $clone->{'AFPNAME'} ;
+
+    # This counter is not the real jobs index in AFP file as com don't guaranty
+    # the com from Converter comes here in the right order
+    $self->{JOBS} ++ ;
+    $self->{JOBSTODO} ++ ;
+
+    # OUTFILE is set from environment returned by conversion
+    ( $clone->{PATH} , $clone->{FILE} ) =
+        $clone->{OUTFILE} =~ m|^(.*)/([^/]*)$| ;
+
+    # Set index to the real number of this job
+    my ( $index ) = $clone->{PATH} =~ /AFP-(\d+)$/ ;
+
+    # Keep this index to control splitting event keeping the maximum value
+    $self->{MAX_CLONE_INDEX} = $index
+        unless ( defined($self->{MAX_CLONE_INDEX})
+        and $index < $self->{MAX_CLONE_INDEX} );
+
+    # Initialize my clone
+    (
+        $clone->{ID},
+        $clone->{ANSWER},
+        $clone->{STATE},
+        $clone->{ERROR},
+        $clone->{ERRORS},
+        $clone->{A2PJOB},
+        $clone->{PARENT},
+        $clone->{INDEX}
+    ) = (
+        $self->{ID} . "-" . $index,
+        "", 0, 0, [],
+        $self->{ID},
+        $self,
+        $index
+    );
+
+    # Undef some unused ref in clone
+    undef $clone->{CLONES} ;
+    undef $clone->{CLONES_OBJ} ;
+
+    # Update print sequence when agregating
+    my $destid = $clone->getdestid ;
+    if ( $destid and $AGREGATE_PRINT ) {
+        $self->{SEQUENCE}->{$destid}->[$index-1] = $clone->{ID} ;
+        $self->jobdebug("Job '$clone->{ID}' is the " .
+            scalar(@{$self->{SEQUENCE}->{$destid}}) . " job found for the '" .
+            $destid . "' sequence");
+
+        $self->{LPRSEQ}->{$destid}  = 0
+            unless (defined($self->{LPRSEQ}->{$destid}));
+        $self->{VLPRSEQ}->{$destid} = 0
+            unless (defined($self->{VLPRSEQ}->{$destid}));
+
+        # Decide now if next print is this clone (yes for the first one and
+        # previous clone is still printed after a long conversion or first one
+        # for a new destid)
+        my $next = $self->{SEQUENCE}->{$destid}->[$self->{LPRSEQ}->{$destid}] ;
+        $clone->{DO_LPR_NOW}  = ($next =~ /^$clone->{ID}$/)? 1 : 0 ;
+        $next = $self->{SEQUENCE}->{$destid}->[$self->{VLPRSEQ}->{$destid}] ;
+        $clone->{DO_VLPR_NOW} = ($next =~ /^$clone->{ID}$/)? 1 : 0 ;
+    }
+
+    # Update filename with clone ID to identify file in zip file and avoid
+    # zipping error
+    $clone->{FILE} = $clone->{ID}   . '-' . $clone->{FILE} ;
+
+    # rename files created by afpds2tex
+    foreach my $ext ( 'tex' , 'arch' , 'trayone' , 'traytwo', 'afp' ) {
+        my ( $orig , $dest ) = (
+            $clone->{OUTFILE} . '.' . $ext ,
+            $clone->{PATH} . '/' . $clone->{FILE} . '.' . $ext
+            );
+
+        if ( -e $orig ) {
+            if ( $ext =~ /tray/ ) {
+                link $orig , $dest
+                    or $clone->error(1,"Can't link '$orig' to '$dest': $!");
+                $self->todelete($orig);
+            } else {
+                rename $orig , $dest
+                    or $clone->error(1,"Can't rename '$orig': $!");
+            }
+        }
+
+        $clone->jobdebug("$ext file renamed to '$clone->{FILE}.$ext'")
+            if ( -e $dest );
+
+        # Set files to be cleaned
+        $self->toclean($dest);
+    }
+    $clone->{OUTFILE} = $clone->{PATH} . '/' . $clone->{FILE} ;
+
+    # Handle TOCLEAN environment used for included resource cleaning
+    $clone->toclean(split(/;/,$clone->{'TOCLEAN'}))
+        if ( exists($clone->{'TOCLEAN'}) and $clone->{'TOCLEAN'} );
+
+    # Set E-Service files to clean if present
+    $self->toclean( $clone->{XML_A2P}, $clone->{XML_A2P}.'.stderr',
+         $clone->{XML_CONTENT}, $clone->{PDFFILE} )
+            if (exists($clone->{XML_A2P}));
+
+    # Add folder
+    $self->todelete($clone->{PATH});
+
+    # Also add A2PJob path to delete if not still added, and the Lock file
+    # created by converter
+    $self->todelete(
+        $SHMDIR . '/' . $self->{ID}, $SHMDIR . '/' . $self->{ID} . '.LCK' );
+
+    # Force to do PDF for archivage, just in case it is used with print
+    # and DO_PDF is not set
+    $clone->{DO_PDF} = 'yes' if ( $clone->do_arch and ! $clone->do_pdf );
+
+    # And reset my used answer, keep clone info
+    $self->{ANSWER} = "" ;
+    $self->{CLONES}->[$index] = $clone->{ID} ;
+
+    # Keep a ref to clone
+    $self->{CLONES_OBJ}->{$clone->{ID}} = $clone ;
+
+    &Debug("Job " . $self->{ID} . " cloned to " . $clone->{ID});
+    map { $clone->jobdebug("{$_}='$clone->{$_}'") }
+        qw( ID A2PJOB STEP OUTFILE PATH FILE COPIES );
+
+    $clone->jobinfo( "Processing AFP JOB '$clone->{ID}-$clone->{JOBNAME}'"
+        .($self->getClientRef?" with a2p v" . A2P_RPM_VERSION : "") );
+
+    &TIMESTAT('NEW_JOB');
+    return bless $clone , $class ;
+}
+
+sub error {
+    my $self  = shift ;
+    my $err   = shift ;
+    my $msg   = shift || "" ;
+
+    if (defined($err)) {
+        my ($package, $filename, $line) = caller;
+        $self->{ERROR} = $err ? $err : 2 ;
+
+        unless (exists($self->{STEPERROR}) and exists($self->{INFOERROR})) {
+            $self->{STEPERROR} = $self->{STEP}
+                unless (exists($self->{STEPERROR}));
+
+            # Update job state only on the first error
+            my $status = $msg ? { STATUS => 'ABTERM', ABTERM => $msg } : {} ;
+            # Extract ABTERM information from message
+            $self->{INFOERROR} = $status->{INFOS} = $1
+                if ( ! exists($self->{INFOERROR})
+                and $msg =~ /^ABTERM:\s+(.*)$/ );
+            $status->{STATUS} = 'KO' if ($self->geta2pjob and $msg);
+            $self->jobstatus( 'A', $status )
+                or &Info("Can't set job error status at step " . $self->{STEP});
+            my $parent = $self->a2pobj ;
+            if ( $parent and $self->{INFOERROR} and ! $parent->{INFOERROR} ) {
+                $parent->{INFOERROR} = $self->{INFOERROR} ;
+                $parent->jobstatus( 'A', $status )
+                    or &Info("Can't set job error status on parent status");
+            }
+        }
+
+        push @{$self->{ERRORS}} , $msg if $msg ;
+
+        my $error = "Error $self->{ERROR} set on Job " . $self->getid() .
+            " at step $self->{STEP}, from L.$line in $package" .
+            ( $msg ? ": $msg" : "" );
+
+        &Error($error);
+        push @{$self->{CLIENTINFO}} , $error if ($self->{CLIENTREF});
+
+        # Update a2pjob to stop our sequence
+        if ( $AGREGATE_PRINT and $err > 700 and my $a2pjob = $self->a2pobj ) {
+            $a2pjob->{$self->getdestid() . '-ERROR'} = 1 ;
+        }
+
+        # Stop any more processing
+        map { $self->{$_} = "no" }
+            qw(DO_PDF DO_PCL DO_PS DO_LPR DO_VLPR DO_ARCH DO_ESERVICE);
+    }
+    return $self->{ERROR} ;
+}
+
+sub setconversionerrorcleaning {
+    # Just update files and folders to clean in shared memory
+    my $self  = shift ;
+
+    my @files = glob( "$self->{JOBDIR}/*" );
+    $self->jobdebug("Setting to clean @files");
+    while (@files) {
+        my $file = shift @files ;
+
+        if (-d $file) {
+            $self->todelete($file);
+            my @newfiles = glob( "$file/*" ) ;
+            $self->jobdebug("Setting to clean @newfiles");
+            push @files, @newfiles ;
+
+        } else {
+            $self->toclean($file);
+        }
+    }
+}
+
+sub badagregation {
+    my $self  = shift ;
+    return 0 unless $AGREGATE_PRINT ;
+    my $a2pjob = $self->a2pobj ;
+    return 0 unless ( $a2pjob );
+    my $key = $self->getdestid() . '-ERROR' ;
+    return ( defined($a2pjob->{$key}) and $a2pjob->{$key} );
+}
+
+sub geterrors {
+    return defined($_[0]->{ERRORS}) ? @{$_[0]->{ERRORS}} : () ;
+}
+
+sub getsteperror {
+    return $_[0]->{STEPERROR} ;
+}
+
+sub start_ms {
+    my $self  = shift ;
+    $self->{START} = time ;
+    $self->{STEPDONE} = 0 ;
+
+    # Update status only at step higher than 2 as jobstatus is initialized
+    # only at step 2 and directly from afpds2tex.pm
+    if ( $self->{STEP} > 2 ) {
+        my $step = $self->{STEP} + 1 ;
+        # Update job state in spool
+        $self->jobstatus( '_', { STATUS=>"RUNNING" })
+            or &Info("Can't set job status at step $step");
+    }
+
+    1 ;
+}
+
+sub get_ms {
+    return  ( time - $_[0]->{START} ) * 1000 ;
+}
+
+sub get_delay {
+    return  sprintf("%.1f ms", ( time - $_[0]->{BIRTH} ) * 1000 );
+}
+
+sub stop_ms {
+    $_[0]->jobinfo("Processed in " . sprintf("%.1f ms",$_[0]->get_ms()) );
+}
+
+sub getpurgetry {
+    return $_[0]->{PURGETRYOUT} -- ;
+}
+
+sub isstep {
+    return $_[0]->{STEP} == $_[1] ;
+}
+
+sub getstep {
+    return $_[0]->{STEP} ;
+}
+
+sub getid {
+    return $_[0]->{ID} ;
+}
+
+sub getindex {
+    return $_[0]->{INDEX} ;
+}
+
+sub getdestid {
+    # DESTID is not defined when just archiving
+    return defined($_[0]->{DESTID}) ? $_[0]->{DESTID} : "" ;
+}
+
+sub getjobname {
+    # JOBNAME is only defined for cloned job
+    return defined($_[0]->{JOBNAME}) ? $_[0]->{JOBNAME} : "" ;
+}
+
+sub printer {
+    $_[0]->{LPROPT} =~ /-P(\S*)/ if (defined($_[0]->{LPROPT}));
+    return defined($1) ? $1 : "oups... none" ;
+}
+
+sub vprinter {
+    $_[0]->{VLPROPT} =~ /-P(\S*)/ if (defined($_[0]->{VLPROPT}));
+    return defined($1) ? $1 : "oups... none" ;
+}
+
+sub getfile {
+    return $_[0]->{FILE} ;
+}
+
+sub getfilestart {
+    return $_[0]->{STARTPOSFILE} || 0 ;
+}
+
+sub toconverter {
+    my $self = shift ;
+    my $startpoint = $self->getfilestart ? ':' . $self->getfilestart : '' ;
+    return $self->request( $self->getfile . $startpoint ) ;
+}
+
+sub getstatistics {
+    my $self  = shift ;
+    my @stats = ( $self->getid(), $self->getdestid() ) ;
+    if ($self->geta2pjob()) {
+        # Return stats of a clone
+        push @stats, $self->getstate == DONE ? "OK" : "KO", "" ;
+
+    } else {
+        # Return stats of an A2P job
+        push @stats, "", $self->getstate == DONE ? "OK" : "KO" ;
+    }
+    push @stats, scalar(@{$self->{ERRORS}}), $self->get_delay, $LOCKID ;
+
+    # Compute job real timing but check it is not concerned by a drift between
+    # clock on NFS server (if used) and local clock
+    if (defined($self->{MTIME})) {
+        my $time = time ;
+        if ($time > $self->{MTIME}) {
+            my $timing = time - $self->{MTIME} ;
+            push @stats, sprintf("%.1f s", $timing );
+            my $index = int(int($timing)/10) ;
+            &UPSTAT('STATISTICS-TIMING-'.$index.'0-'.(++$index).'0s');
+
+        } else {
+            &Info("Can't compute job timing as it seems newer than now");
+            push @stats, "BADCLOCK" ;
+            &UPSTAT('BAD-STATISTICS-TIMING');
+        }
+    }
+
+    return @stats ;
+}
+
+sub getstate {
+    # After cleanning we count total number of errors
+    return ( $_[0]->isstep(11) and defined($_[0]->{CLEAN_CMD}) )?
+        ( grep { $_ != DONE } @{$_[0]->{CLEAN_CMD}} or DONE ) : $_[0]->{STATE} ;
+}
+
+sub getClientRef {
+    return $_[0]->{CLIENTREF} ;
+}
+
+sub unsetClientRef {
+    $_[0]->{CLIENTREF} = 0 ;
+    1 ;
+}
+
+sub getanswer {
+    return $_[0]->{ANSWER} ;
+}
+
+sub geta2pjob {
+    return $_[0]->{A2PJOB} ;
+}
+
+sub a2pobj {
+    my $self = shift;
+    return defined($self->{PARENT}) ? $self->{PARENT} : 0 ;
+}
+
+sub nomorejob {
+    return $_[0]->{JOBSTODO} ? 0 : 1 ;
+}
+
+sub getclone {
+    my $self = shift;
+    my $id   = shift;
+    return defined($self->{CLONES_OBJ}->{$id}) ?
+        $self->{CLONES_OBJ}->{$id} : 0 ;
+}
+
+sub getallclones {
+    my $self = shift;
+    return () unless (defined($self->{CLONES}));
+
+    # Returns every clones finished or not
+    return map { ref($_) ? $$_ : $_ } grep { defined } @{$self->{CLONES}} ;
+}
+
+sub getclones {
+    my $self = shift;
+    return () unless (defined($self->{CLONES}));
+
+    # Returns only not finished clones
+    return grep { defined and ! ref($_) } @{$self->{CLONES}} ;
+}
+
+sub getfinishedclones {
+    my $self = shift ;
+    return () unless (defined($self->{CLONES}));
+
+    # Returns finished clones
+    # When not finished, the ref is empty so it not selected, but when one is
+    # is finished, it is replaced by a scalar ref to the clone ID
+    return map { $$_ } grep { defined and ref($_) } @{$self->{CLONES}} ;
+}
+
+sub get2delete {
+    my $self = shift;
+    return $self->getfromlist('DELETE');
+}
+
+sub get2clean {
+    my $self = shift;
+    return $self->getfromlist('CLEAN');
+}
+
+sub get2move {
+    my $self = shift;
+    return $self->getfromlist('MOVE');
+}
+
+sub getfromlist {
+    my $self = shift ;
+    $self->{$_[0].'HASH'} = {} unless (defined($self->{$_[0].'HASH'}));
+    return @{$self->{$_[0]}} = keys(%{$self->{$_[0].'HASH'}});
+}
+
+sub addtomyarray {
+    my $self = shift ;
+    my $key  = shift ;
+    map { $self->{$key.'HASH'}->{$_} = 1 } @_ ;
+}
+
+sub todelete {
+    my $self = shift ;
+    $self->addtomyarray('DELETE',@_);
+}
+
+sub toclean {
+    my $self = shift ;
+    $self->addtomyarray('CLEAN',@_);
+}
+
+sub tomove {
+    my $self = shift ;
+    $self->addtomyarray('MOVE',@_);
+}
+
+sub do_move_cmd {
+    my $self = shift ;
+    # Return move commands list size if still passed in move_files_cmd member
+    return scalar(@{$self->{MOVE_CMDS}}) if (defined($self->{MOVE_CMDS}));
+
+    # Then should check if we need to move file
+    return $self->{FILE2MOVE} if ( $self->{FILE2MOVE} );
+
+    # To avoid keeping previous step status
+    $self->{STATE} = DONE ;
+
+    $self->{FILE2MOVE} = grep { -e $_ and -f $_ } $self->get2move ;
+    return $self->{FILE2MOVE} ;
+}
+
+sub move_files_cmd {
+    my $self = shift ;
+
+    # Return cached move command
+    return shift(@{$self->{MOVE_CMDS}}) if (defined($self->{MOVE_CMDS}));
+
+    if ( ! -d $self->{JOBDIR} ) {
+        $self->error(8,"Job dir not set, won't move anything");
+        return undef ;
+    }
+
+    my $dest = $self->error ? $ERRORSPOOL : $DONESPOOL ;
+    my $output = $self->{JOBDIR} . "/mv_commands.output" ;
+    $self->toclean( $output );
+
+    # Cached move commands
+    @{$self->{MOVE_CMDS}} = map {
+        $self->request( "mv -f $_ $dest >>$output 2>&1" ) }
+            ( grep { -e $_ and -f $_ } $self->get2move );
+
+    # Keep commands number to initialize step 11 progression
+    $self->{NB_CMDS} = scalar(@{$self->{MOVE_CMDS}});
+
+    return shift(@{$self->{MOVE_CMDS}}) ;
+}
+
+sub setstep {
+    return $_[0]->{STEP} = $_[1] ;
+}
+
+sub setfile {
+    return $_[0]->{FILE} = $_[1] ;
+}
+
+sub setstartpos {
+    return $_[0]->{STARTPOSFILE} = $_[1] ;
+}
+
+sub setjobdir {
+    my $self  = shift ;
+
+    return if ( $self->{JOBDIR} and -d $self->{JOBDIR} );
+
+    # When must set this only one time
+    $self->{JOBDIR} = $_[0] ;
+    $self->jobdebug("Jobdir folder is set to " . $self->{JOBDIR});
+
+    # Don't forget to delete LCK file
+    $self->todelete($_[0], $_[0] . '.LCK');
+}
+
+sub setstate  {
+    my $self  = shift ;
+    my $state = shift ;
+
+    if ( $self->isstep(11) and defined($_[0]->{CLEAN_CMD}) ) {
+        # When cleaning, we can received a state DONE after a bad STATE so keep
+        push @{$self->{CLEAN_CMD}} , $state ;
+
+    } else {
+        $self->{STATE} = $state ;
+    }
+    $self->jobdebug("Setting state to " .
+        ( defined($means{$state}) ? $means{$state} : "'$state'" ));
+}
+
+sub jobdone {
+    my $self  = shift ;
+    my $clone = shift ;
+    -- $self->{JOBSTODO} ;
+
+    # Replace ID in list by a ref to ID to set it done
+    my $CLONE_ID = $clone->getid ;
+    $self->{CLONES}->[$clone->getindex] = \$CLONE_ID ;
+
+    # Keep clone info in parent
+    $self->mergeinfo( $CLONE_ID )
+        if ( $MAX_BACKLOG and $KEEP_DYNAMIC_JOB_LOG > 0 );
+}
+
+sub clearjobsdone {
+    my $self  = shift ;
+
+    # Keep internal statistics which can be correlated to diagnostics tests
+    &UPSTAT('JOB-NBJOBS-'.$self->getallclones.'-'.
+        ($self->getstate == DONE ? "DONE" : "ERROR-".$self->error)) ;
+
+    # Deleting last references to clone objects
+    delete $self->{CLONES_OBJ} unless ($self->error);
+}
+
+sub stepnotdone {
+    return $_[0]->{STEPDONE} ? 0 : 1 ;
+}
+
+sub stepdone {
+    my $self = shift ;
+    my $ret  = 1 ;
+    my $step = $self->{STEP} ;
+
+    $self->{STEPDONE} = 1 ;
+
+    my $info = { STATUS => 'STEPDONE', INFOS => '' } ;
+    if ( $step == 10 and ! $self->geta2pjob ) {
+        # Step 10 finished for main job, about to do cleaning
+        $info->{INFOS} = 'Cleaning' ;
+
+    } elsif ( $step == 12 ) {
+        $info->{STATUS} = 'DONE' ;
+        $info->{INFOS}  = $self->cancelled ? 'Cancelled' : 'Stopped' ;
+    }
+
+    delete $info->{INFOS} if (exists($self->{STEPERROR}));
+
+    # Update status to STEPDONE for clone only before step 10
+    # Step 10 status is updated directly by Archiver or E-Service
+    $self->jobstatus( 'o', $info ) unless ( $self->geta2pjob and $step < 10 );
+
+    $ret or &Info("Can't set job done status at step $step");
+}
+
+sub stepskip {
+    my $self = shift ;
+
+    $self->nextstep(@_);
+}
+
+sub setanswer {
+    $_[0]->{ANSWER} = $_[1];
+    $_[0]->jobdebug("Received \"$_[1]\" answer");
+}
+
+sub is_not_abterm {
+    return defined($_[0]->{ALERTED}) ? 0 : 1 ;
+}
+
+sub jobdump {
+    my $Job = shift ;
+    return ( "
+
+############################# JOB DUMP ####################################
+Job $Job object dump:" , eval 'use Data::Dumper ; Dumper($Job)' ) ;
+}
+
+sub jobalert {
+    my $self = shift ;
+    return unless ( $self->error or $JOB_DUMP_ON_ERROR );
+    return if (defined($self->{ALERTED}));
+
+    my @Alerts = @_ ? @_ : ( "ABTERM: Job " . $self->getid ,
+        "ABTERM: Job $self->{ID} is in errors:",
+        $self->geterrors );
+
+    if ($self->{CLIENTREF}) {
+        push @{$self->{CLIENTINFO}} , @Alerts ;
+        &AlertError( @Alerts );
+
+    } else {
+        push @Alerts, $self->jobdump
+            if ($JOB_DUMP_ON_ERROR);
+
+        &AttachZipToAlertError($self->{ZIPFILE})
+            if (defined($self->{ZIPFILE}) and $JOIN_ZIP_ON_ERROR);
+        &Alert( @Alerts );
+    }
+
+    $self->{ALERTED} = 1 ;
+}
+
+sub keepinfo {
+    # We can keep last info on a timed keys hash to only keep most recent
+    my $self = shift ;
+    my $time = sprintf("%.3f",time);
+    $self->{KEEP_INFO}->{$time} =
+        [ map { $self->{ID} . '@step' . $self->{STEP} . ': ' . $_ } @{$_[0]} ];
+
+    while ( @{$self->{TIMED_INFO}} and @{$self->{TIMED_INFO}} > $MAX_BACKLOG ) {
+        my $timeshift = shift @{$self->{TIMED_INFO}} ;
+        delete $self->{KEEP_INFO}->{$timeshift} ;
+    }
+
+    push @{$self->{TIMED_INFO}}, $time ;
+}
+
+sub mergeinfo {
+&TIMESTAT('mergeinfo');
+
+    # Merge info from clone in parent: we can delete info in clone
+    # at the same time
+    my $self  = shift ;
+    my $clone = shift ;
+
+    # Clone can be deleted during unrecoverable error
+    return unless ($self->getclone($clone));
+
+    # Replace clone name by the object
+    my $clone = $self->getclone($clone) ;
+    my @time_imported = @{$clone->{TIMED_INFO}} ;
+    $clone->{TIMED_INFO} = [] ;
+    my $hashref = $clone->{KEEP_INFO} ;
+
+    foreach my $time ( @time_imported ) {
+        if (defined($self->{KEEP_INFO}->{$time})) {
+
+            # First check we are not getting a known info
+            unless ( $hashref->{$time} == $self->{KEEP_INFO}->{$time} ) {
+                push @{$self->{KEEP_INFO}->{$time}}, @{$hashref->{$time}};
+            }
+
+        } elsif ( $time > $self->{TIMED_INFO}->[0] ) {
+            shift @{$self->{TIMED_INFO}}
+                unless ( @{$self->{TIMED_INFO}} < $MAX_BACKLOG );
+
+            $self->{KEEP_INFO}->{$time} = $hashref->{$time} ;
+            if ( $time > $self->{TIMED_INFO}->[$#{$self->{TIMED_INFO}}] ) {
+                push @{$self->{TIMED_INFO}}, $time ;
+
+            } else {
+                # Here we need to insert so, just resort used keys... this could
+                # be time consuming ?
+                $self->{TIMED_INFO} = [
+                    sort(keys(%{$self->{KEEP_INFO}->{$time}}))
+                    ] ;
+            }
+        }
+        # Then erase the ref in clone
+        delete $hashref->{$time} ;
+    }
+
+    # Finally erase the keep_info hash ref in clone
+    delete $clone->{KEEP_INFO} ;
+
+&TIMESTAT('mergeinfo');
+}
+
+sub jobinfo {
+    my $self = shift ;
+    return unless (defined($_[0]));
+    $self->{LAST_INFO} = [ @_ ] ; # Just to keep a trace in dumped object
+
+    $self->keepinfo( \@_ )
+        if ( $MAX_BACKLOG and $KEEP_DYNAMIC_JOB_LOG > 0 );
+
+    my $info = $self->{ID} .
+        ( $self->{STEP} ? ": Step " . $self->{STEP} : "" ) . ", " . $_[0] ;
+
+    if ( $self->{STEP} < 2 ) {
+        push @{$self->{INFO}}, $info ;
+
+    } else {
+        push @{$self->{CLIENTINFO}} , $info if ($self->{CLIENTREF});
+        &Info( $info );
+    }
+}
+
+sub releaseinfo {
+    # Don't release info if info is not interesting, but release if debugging
+    return if ( $NO_SYSLOG_DEBUG and $_[0]->{STATE} == NOMOREFILE );
+    &Info( @{$_[0]->{INFO}} );
+    push @{$_[0]->{CLIENTINFO}} , @{$_[0]->{INFO}} if ($_[0]->{CLIENTREF});
+    undef $_[0]->{INFO} ;
+}
+
+sub jobdebug {
+    my $self = shift ;
+    return unless @_ ;
+    $self->{LAST_DEBUG} = [ @_ ] ; # Just to keep a trace in dumped object
+
+    $self->keepinfo( \@_ )
+        if ( $MAX_BACKLOG and $KEEP_DYNAMIC_JOB_LOG > 1 );
+
+    return if ( $NO_SYSLOG_DEBUG );
+
+    my @sub = caller(1);
+    my ( $sub ) = $sub[3] =~ /^.*::([^:]*)$/ ;
+    return if ( $sub and $NODEBUG_SUB_LIST =~ /$sub/ );
+
+    local $" = '' ;
+    &Debug($self->getid . ": Step $self->{STEP}, $sub, L.$sub[2], @_");
+}
+
+sub getClientInfo {
+    my $self = shift ;
+    # Return nothing unless is client request and at least one info is in buffer
+    return () unless ( $self->{CLIENTREF} and @{$self->{CLIENTINFO}} );
+
+    my @info = ( $self->{CLIENTREF} );
+    push @info , @{$self->{CLIENTINFO}} ;
+    @{$self->{CLIENTINFO}} = () ;
+    return @info ;
+}
+
+sub nextstep {
+    my $self = shift ;
+
+    ++ $self->{STEP} ;
+    $self->jobinfo($_[0]) if @_ ;
+}
+
+sub do_pdf {
+    return defined($_[0]->{DO_PDF})?
+        ( $_[0]->{DO_PDF}  =~ /^yes$/i ? 1 : 0 ) : 0 ;
+}
+
+sub do_ps {
+    return defined($_[0]->{DO_PS})?
+        ( $_[0]->{DO_PS}   =~ /^yes$/i ? 1 : 0 ) : 0 ;
+}
+
+# $PARALLELE_VALIDATION flag can be 0, 1 or 2
+# 0 => No validation
+# 1 => Validation duplication
+# 2 => Only validation
+sub do_pcl {
+    my $self = shift ;
+    if (defined($self->{DO_PCL})) {
+        return 1
+            if ( $self->{DO_PCL} =~ /^yes$/i and $PARALLELE_VALIDATION < 2 );
+    }
+    return 0 ;
+}
+
+sub do_vpcl {
+    my $self = shift ;
+    if (defined($self->{DO_PCL})) {
+        return 1 if ( $self->{DO_PCL} =~ /^yes$/i and $PARALLELE_VALIDATION );
+    }
+    return 0 ;
+}
+
+sub do_lpr {
+    my $self = shift ;
+    my $ref  = shift ;
+    if ( defined($self->{DO_LPR}) and ! $DONT_PRINT
+            and (defined($self->{DO_LPR_NOW}) or ! $AGREGATE_PRINT)) {
+        if (defined($ref)) {
+            # Checking sequence processing
+            if ( $self->{DO_LPR} =~ /^yes$/i and $PARALLELE_VALIDATION < 2 ) {
+
+                return $self->{DO_LPR} = 1 unless $AGREGATE_PRINT ;
+
+                # Default to waiting sequence is ready
+                $$ref = 1 ;
+
+                # We must wait until sequence is ready (essentially we are
+                # knowing every thing about cloned jobs to set sequence
+                # correctly)
+                if ($self->sequence_ready()) {
+                    # Check we can print now saving last check value as control
+                    if ($self->{LAST_CHECK} = $self->{DO_LPR_NOW}) {
+                        return $self->{DO_LPR} = 1 ;
+
+                    } else {
+                        return 0 ;
+                    }
+
+                } else {
+                    return $self->{LAST_CHECK} = 0 ;
+                }
+
+            } else {
+                # No print required
+                return $self->{DO_LPR} = 0 ;
+            }
+
+        } else {
+            # Checking step processing
+            return $self->{DO_LPR} ;
+        }
+    }
+    return $self->{LAST_DEFAULT} = 0 ;
+}
+
+sub do_vlpr {
+    my $self = shift ;
+    my $ref  = shift ;
+    if ( defined($self->{DO_VLPR}) and ! $DONT_PRINT
+    and defined($self->{DO_VLPR_NOW})) {
+        if (defined($ref)) {
+            if ( $self->{DO_VLPR} =~ /^yes$/i and $PARALLELE_VALIDATION ) {
+
+                return $self->{DO_VLPR} = 1 unless $AGREGATE_PRINT ;
+
+                $$ref = 1 ;
+                if ($self->sequence_ready()) {
+                    if ($self->{LAST_CHECK} = $self->{DO_VLPR_NOW}) {
+                        return $self->{DO_VLPR} = 1 ;
+
+                    } else {
+                        return 0 ;
+                    }
+
+                } else {
+                    return $self->{LAST_CHECK} = 0 ;
+                }
+
+            } else {
+                return $self->{DO_VLPR} = 0 ;
+            }
+
+        } else {
+            return $self->{DO_VLPR} ;
+        }
+    }
+    return 0 ;
+}
+
+sub waiting {
+    my $self = shift ;
+    return @_ ? $self->{WAITING} = shift : $self->{WAITING} ;
+}
+
+sub sequence_ready {
+    # Set agregation count down to the total number of print with correction
+    my $self = shift ;
+    return 0 unless $AGREGATE_PRINT ;
+
+    # Returns checked value to avoid concurrencing that involves first job will
+    # waiting in place of starting its own sequence
+    if ( $self->{SEQREADY} ) {
+        my $ready = 1 ;
+        if (defined($self->{LAST_CHECK})) {
+            $ready = $self->{LAST_CHECK} ;
+            delete $self->{LAST_CHECK} ;
+        }
+        return $ready ;
+    }
+
+    unless ( $self->geta2pjob() ) {
+        my @count = grep { -d $_ } glob( $self->{JOBDIR} . "/AFP-*" );
+        return $self->{AGREGATION_COUNT} = @count ;
+    }
+
+    my $a2pjob ;
+    return 0 unless ( $a2pjob = $self->a2pobj );
+    # Return higher cache state
+    return $self->{SEQREADY} = 1 if ( $a2pjob->{SEQREADY} );
+
+    # Here we must completly update the sequence arrays when we are
+    # knowing every things of jobs
+    return 0 unless (defined($a2pjob->{AGREGATION_COUNT}) and
+        $a2pjob->{AGREGATION_COUNT} == $a2pjob->{JOBS} + $a2pjob->{SEQREMOVED});
+
+    # Here we are sure sequence arrays should be completed, but they can exist
+    # with holes if more than one destid is used, we should come here only one
+    # time, so don't forget to check every sequence dependant variables
+    my $control = 0 ;
+    foreach my $destid (keys(%{$a2pjob->{SEQUENCE}})) {
+        @{$a2pjob->{SEQUENCE}->{$destid}} =
+            grep { defined($_) and $_ } @{$a2pjob->{SEQUENCE}->{$destid}} ;
+        $control += @{$a2pjob->{SEQUENCE}->{$destid}} ;
+
+        # Check current first clones in the sequences will start the sequence
+        my $seqindex = $a2pjob->{LPRSEQ}->{$destid} ;
+        my $cloneid = $a2pjob->{SEQUENCE}->{$destid}->[$seqindex] ;
+        my $clone = $a2pjob->getclone($cloneid) ;
+        $clone->{DO_LPR_NOW} = 1 ;
+
+        $seqindex = $a2pjob->{VLPRSEQ}->{$destid} ;
+        $cloneid = $a2pjob->{SEQUENCE}->{$destid}->[$seqindex] ;
+        $clone = $a2pjob->getclone($cloneid) ;
+        $clone->{DO_VLPR_NOW} = 1 ;
+    }
+
+    $self->error(846,"Can't compute the sequence for this job ")
+        unless ( $control == $a2pjob->{JOBS} );
+
+    $a2pjob->{SEQREADY} = 1 ;
+    $self->{SEQREADY} = 1 ;
+    return 0 ;
+    # Return 0 to force the Job to not be waiting, as the SEQREADY
+    # is cached, it will be processed very soon
+}
+
+sub next_is_waiting {
+    my $self = shift ;
+    my $next = $self->next_in_sequence ;
+    return 0 unless $next ;
+
+    my $a2pjob ;
+    return 0 unless ( $a2pjob = $self->a2pobj );
+
+    my $clone ;
+    return 0 unless ( $clone = $a2pjob->getclone($next) );
+    return $clone->{WAITING} ;
+}
+
+sub remove_from_sequence_but_authorize_next {
+    # Only called in case of error. We must adapt the authorization sequence
+    # and if we must authorize next job in the sequence
+    my $self = shift ;
+
+    # Really needed if a destid is defined
+    my $destid = $self->getdestid
+        or return 0 ;
+
+    my $a2pjob ;
+    return 0 unless ( $a2pjob = $self->a2pobj );
+
+    # Check if this job is the next waited
+    my $next = $self->{STEP} < 9 ?
+        $a2pjob->{LPRSEQ}->{$destid} : $a2pjob->{VLPRSEQ}->{$destid} ;
+    $self->jobdebug("Current next job in the sequence has the index $next.");
+
+    # Check which job is the next in the sequence
+    my $ref = $a2pjob->{SEQUENCE}->{$destid} ;
+    my ( $myid, $nextid ) = ( $self->getid, $ref->[$next] ) ;
+
+    # Remove this one from the sequence
+    unless (defined($self->{ISSEQREMOVED})) {
+        # Purging list from our id
+        my $jobid = "" ;
+        my @temp = () ;
+        while ( @{$ref} ) {
+            $jobid = pop @{$ref};
+            last if ( $jobid eq $myid and $self->{ISSEQREMOVED} = 1 );
+            unshift @temp , $jobid ;
+        }
+        push @{$ref}, @temp if @temp ;
+
+        # This job is removed and can't be counted later if sequence is still
+        # not ready
+        $a2pjob->{JOBS} -- ;
+        $a2pjob->{SEQREMOVED} ++ ;
+
+        # Last check and message, just in case
+        if ( $jobid eq $myid ) {
+            $self->jobinfo("$myid removed from $destid print sequence");
+
+        } else {
+            $self->error($self->getstep()*111,
+                "Can't remove '$myid' from printing sequence ($jobid;@temp)");
+        }
+    }
+
+    # Return true to still authorize the next if we were the next expected
+    return ( $myid eq $nextid ) ? 1 : 0 ;
+}
+
+sub next_in_sequence {
+    my $self = shift ;
+    return 0 unless $AGREGATE_PRINT ;
+    my $key  = $self->getid() . '-SEQNEXTID' ;
+
+    my $a2pjob ;
+    return $self->{$key} = "" unless ( $a2pjob = $self->a2pobj );
+
+    # Return eventually cached value if not in error
+    my $clone = $a2pjob->getclone($self->{$key});
+    return $self->{$key}
+        if (defined($self->{$key}) and $clone and ! $clone->error );
+
+    my $nextid = "" ;
+    my $destid = $self->getdestid ;
+    return $self->{$key} = "" unless $destid ;
+
+    my $next = $self->{STEP} < 9 ?
+        $a2pjob->{LPRSEQ}->{$destid} : $a2pjob->{VLPRSEQ}->{$destid} ;
+    $self->jobdebug("The next job in the sequence has the index $next.");
+
+    my $ref = $a2pjob->{SEQUENCE}->{$destid} ;
+    if (defined($ref) and $next < @{$ref} ) {
+        $nextid = $ref->[$next] ;
+        $self->jobdebug("The job $next in the sequence is '$nextid'");
+        # Get next id in sequence if it's still our
+        if ( $self->getid =~ /^$nextid$/ ) {
+            if ( ++$next < @{$ref} ) {
+                $nextid = $ref->[$next] ;
+            } else {
+                $nextid = "" ;
+            }
+        }
+    }
+    $self->jobdebug($nextid?"The job after me is '$nextid'":"No job after me");
+    return $self->{$key} = $nextid ;
+}
+
+sub get_authorization_key {
+    my $self = shift ;
+    return $self->getid() . '-NEXT-AUTHORIZED-' . $self->{STEP} ;
+}
+
+sub get_next_authorized {
+    my $self = shift ;
+    my $key  = $self->get_authorization_key ;
+    return defined($self->{$key}) ? $self->{$key} : "" ;
+}
+
+sub authorize_next_print {
+    my $self = shift ;
+    my $key  = $self->get_authorization_key ;
+
+    # We can only authorize one time
+    return "" if (defined($self->{$key}));
+
+    # Nothing to authorize if destid is not set
+    my $destid = $self->getdestid ;
+    return $self->{$key} = "" unless $destid ;
+
+    my $a2pjob ;
+    return $self->{$key} = "" unless ( $a2pjob = $self->a2pobj );
+
+    # Update sequence index
+    my $next = $self->{STEP} < 9 ?
+        ++ $a2pjob->{LPRSEQ}->{$destid}
+        :
+        ++ $a2pjob->{VLPRSEQ}->{$destid} ;
+
+    $self->jobdebug("Will authorize job $next in the sequence");
+
+    # Get next jobid in sequence to autorize unless at the end of sequence
+    my $nextid = $self->next_in_sequence ;
+    if ( $nextid ) {
+        my $clone ;
+        if ( $clone = $a2pjob->getclone($nextid) ) {
+            $self->jobdebug("Authorizing '$nextid' to print");
+            $clone->authorize_print($self->{STEP});
+            # Return next id caching it for next call if still not cached
+            return $self->{$key} = $nextid ;
+
+        } else {
+            $self->error(9,"Can't authorize '$nextid' to print, no such job");
+        }
+
+    } elsif (defined($a2pjob->{SEQUENCE}->{$destid})) {
+        $self->jobdebug("No print to authorize as this is the end of sequence");
+
+    } else {
+        $self->error(10,"No sequence found for destid '$destid'");
+    }
+
+    return $self->{$key} = "" ;
+}
+
+sub authorize_print {
+    my $self = shift ;
+    # We must be authorized at the same step from the previous job
+    my $step = shift ;
+    $self->jobdebug("Authorized to print at step $step");
+    $self->{ $step < 9 ? 'DO_LPR_NOW' : 'DO_VLPR_NOW' } = 1 ;
+}
+
+sub do_arch {
+    my $self = shift ;
+    my $test = defined($self->{DO_ARCH}) ?
+        ( $self->{DO_ARCH} =~ /^yes$/i ? 1 : 0 ) : 0 ;
+    $self->error(10,"ABTERM: Archivage requested but not activated in service")
+        if ( $test and ! $ARCH_ENABLED );
+    return $ARCH_ENABLED ? $test : 0 ;
+}
+
+sub do_eservice {
+    my $self = shift ;
+    my $test = defined($self->{DO_ESERVICE}) ?
+        ( $self->{DO_ESERVICE} =~ /^yes$/i ? 1 : 0 ) : 0 ;
+
+    if ( $test ) {
+        if ( $ESERVICE_ENABLED ) {
+            # At this stage we can return disabling DO_ARCH
+            return $self->{DO_ARCH} = 'reset for e-service' ;
+
+        } else {
+            $self->error( 10,
+                "ABTERM: E-Service requested but not activated in service" );
+        }
+    }
+    return 0 ;
+}
+
+sub getPdfName {
+    my $self = shift ;
+    if ( defined($self->{PDFFILE}) and $self->{PDFFILE} ) {
+        $self->{PDFFILE} =~ m|([^/]+)$| ;
+        return $1 ;
+    }
+    return $LOCKID . '-' . $self->{ID} . '_' . $self->{JOBNAME} . '.pdf' ;
+}
+
+sub pdf_cmd {
+    my $self = shift ;
+    my $output = $self->{ID} . "-pdf_cmd.output" ;
+    $self->{PDFFILE} = $self->getPdfName ;
+
+    $self->todelete( $self->{OUTFILE} . ".aux" );
+    $self->toclean(
+        $self->{PATH} . "/" . $output , $self->{PATH} . "/missfont.log" ,
+        $self->{OUTFILE} . ".pdf" ,
+        $self->{OUTFILE} . ".log" );
+    my $pdfname = $self->{PDFFILE} =~ /^$SHMDIR/ ?
+        $self->{PDFFILE} : $self->{PATH} . "/" . $self->{PDFFILE} ;
+    $DONTZIPPDF ? $self->tomove($pdfname) : $self->toclean($pdfname) ;
+    push @{$self->{PDFS}}, $pdfname ;
+
+    return $self->request(
+        "cd $self->{PATH} ; while [ -e '$self->{FILE}.tex.LCK' ] ; do " .
+        "usleep $USLEEP ; done ; " .
+        "LANG=C pdflatex --interaction batchmode $self->{FILE} >$output 2>&1");
+}
+
+sub split_cmd {
+    my $self = shift ;
+
+    # Avoid splitting without SPLIT_TRIGGER defined
+    return undef
+        unless (defined($self->{SPLIT_TRIGGER}) and $self->{SPLIT_TRIGGER} );
+
+    # Need to wait after all clones are initialized
+    return 0 if ( $self->{MAX_CLONE_INDEX} - $self->getallclones );
+
+    &UPSTAT('SPLIT-CMD');
+
+    my $jobdir = $self->{JOBDIR} ;
+    my $cmd = "cd $jobdir ; cat " ;
+
+    # We have some afp to agregate to a new file in spool, and we need this
+    # list as an ordered list
+    foreach my $job ( $self->getallclones ) {
+        my $clone = $self->getclone($job) ;
+        return $self->error( 90, "Can't split AFP with $job sub job")
+            unless (defined($clone));
+
+        return $self->error( 91, "Can't split AFP without $job afp file")
+            unless (exists($clone->{OUTFILE}) and $clone->{OUTFILE});
+
+        my $file = $clone->{OUTFILE} . '.afp' ;
+        return $self->error( 92, "Can't split AFP without AFP $job extracted")
+            unless ( -s $file );
+
+        # Get clone extracted .afp path relative to jobdir
+        my ( $path ) = $file =~ m|$jobdir/(.*)$| ;
+
+        $cmd .= $path . " " ;
+    }
+
+    # Now it is safe to forget this API for next call from JobManager
+    delete $self->{SPLIT_TRIGGER} ;
+
+    # Now FILE would be the new one if still not set
+    $self->{FILE} = $self->{SPLITTED_FILE} . '.' . $self->{SPLIT_TAG} ;
+
+    # Now add output file direction
+    $cmd .= '>' . $AFPSPOOL . '/' . $self->{FILE} ;
+
+    # Get stderr if necessary
+    $cmd .= ' 2>split_cmd.stderr' ;
+    $self->toclean($jobdir . '/split_cmd.stderr');
+
+    my $req = $self->request($cmd);
+    &MAXSTAT('SPLIT-CMD-REQ-SIZE',length($req));
+
+    return $req ;
+}
+
+sub split_from {
+    my $self = shift ;
+    my $job  = shift ;
+
+    # Get next pos in the file for the next job
+    my $pos = $job->{'SPLIT_FILE'} ;
+
+    # Set the same file as splitted job but with a startpoint
+    $self->setanswer($job->getfile);
+    $self->setstartpos($pos);
+
+    # Keep a copy of SPLIT_TAGS informations to avoid duplicated tags
+    $self->{'SPLIT_TAGS'} = $job->{'SPLIT_TAGS'} ;
+
+    # Still set our TAG from previous TAG2 job, necessary for the last job
+    $self->{'SPLIT_TAG'} = $job->{'SPLIT_TAG2'} ;
+
+    # Keep the original splitted file in mind
+    $self->{'SPLITTED_FILE'} = $job->{'SPLITTED_FILE'} ;
+
+    # Still define SPLIT_TRIGGER for splitter command, especially for the
+    # last splitted job
+    $self->{'SPLIT_TRIGGER'} = 1 ;
+}
+
+sub is_splitted {
+    return exists($_[0]->{'SPLIT_TAG'}) ? 1 : 0 ;
+}
+
+sub request {
+    my $self = shift ;
+    return $self->{LASTREQUEST} = &GetCom( comJOB , $self->{ID} , @_ );
+}
+
+sub eservice_request {
+    my $self = shift ;
+    return $self->{ESERVICE_REQ} if (defined($self->{ESERVICE_REQ}));
+
+    $self->{ESERVICE_REQ} = $self->request(
+            &GetCom( comFILE , $self->{E_SERVICE} , $self->{XML_A2P} ));
+}
+
+sub eservice_name {
+    return $_[0]->{E_SERVICE} || "" ;
+}
+
+sub getpdffiles {
+    return defined($_[0]->{PDFS})?@{$_[0]->{PDFS}}:() ;
+}
+
+sub rename_pdf {
+    my $self = shift ;
+    return unless $self->{STATE} == DONE ;
+    my $file = $self->{PDFFILE} =~ m|^/| ?
+        $self->{PDFFILE} : "$self->{PATH}/$self->{PDFFILE}" ;
+    rename "$self->{PATH}/$self->{FILE}.pdf", $file
+        or $self->error(1,"Can't rename pdf file from '$self->{FILE}.pdf' to '"
+        . $file . "': $!");
+}
+
+sub dvi_cmd {
+    my $self = shift ;
+    my $output = $self->{ID} . "-latex_cmd.output" ;
+
+    # We must delete .aux file generated by pdflatex command
+    unlink $self->{OUTFILE} . ".aux" if ( -e $self->{OUTFILE} . ".aux" );
+
+    $self->todelete( $self->{OUTFILE} . ".aux" );
+    $self->toclean(
+        $self->{PATH} . "/" . $output , $self->{PATH} . "/missfont.log" ,
+        $self->{OUTFILE} . ".dvi" ,
+        $self->{OUTFILE} . ".log" );
+
+    return $self->request(
+        "cd $self->{PATH} ; while [ -e '$self->{FILE}.tex.LCK' ] ; do " .
+        "usleep $USLEEP ; done ; " .
+        "LANG=C latex --interaction batchmode $self->{FILE} >$output 2>&1");
+}
+
+################################################################################
+# Compute the command to produce PCL code
+# 1. Update variables to specify which file to produce
+# 2. Update list of files to clean in later step
+# 3. Return the command to pass to an active backend
+sub pcl_cmd {
+    my $self = shift ;
+    my $output = $self->{ID} . "-pcl_cmd.output" ;
+    my $command = "cd '$self->{PATH}'; ( export LANG=C ;" ;
+    # Update dvilj command options
+    my $DVILJOPT = '-c' . $self->{COPIES} . ' ' . $self->{DVILJOPT} ;
+
+    if ( $ADDPCL_JOBNAME and $self->getjobname()
+    and $self->{DVILJOPT} =~ /-J/) {
+        my $jobname = $self->getjobname() ;
+        $jobname =~ s/\s+/_/ ; # Check to keep no space in name
+        $DVILJOPT =~ s/-J/-J$jobname/ ;
+    }
+
+    if ( $ADDPCL_USERNAME and $self->getusername()
+    and $self->{DVILJOPT} =~ /-U/) {
+        my $username = $self->getusername() ;
+        $username =~ s/\s+/_/ ; # Check to keep no space in name
+        $DVILJOPT =~ s/-U/-U$username/ ;
+    }
+
+    ###1
+    $self->{PCLFILE}  = $self->{OUTFILE} . ".pcl";
+    $self->{LPRFILE}  = $self->{PCLFILE} ;
+    # At that time PCL validation file if the same than original printed
+    # Later we will update it if dvilj command has different options
+    $self->{VLPRFILE} = $self->{PCLFILE} ;
+
+    ###2
+    $self->todelete( $self->{OUTFILE} . ".aux" );
+    $self->toclean(
+        $self->{PATH} . "/" . $output ,
+        $self->{OUTFILE} . ".dvicopy" ,
+        $self->{PCLFILE} , $self->{LPRFILE}, $self->{VLPRFILE} );
+
+    ###3
+    return $self->request( $command .
+        "if dvicopy $self->{FILE}.dvi $self->{FILE}.dvicopy ; then " .
+            "$DVILJ -v $DVILJOPT -e$self->{PCLFILE} $self->{FILE}.dvicopy ;" .
+        "else echo \"dvicopy error: \$?\" ; exit 1 ; fi ) >$output 2>&1" );
+}
+
+################################################################################
+# Call a function from AFPDS/PCL.pm that check PCL code if necessary
+sub valid_pcl {
+    return unless $_[0]->{STATE} == DONE ;
+    $_[0]->{STATE} = 5 if (&validate_pcl5($_[0]->{PCLFILE}));
+}
+
+################################################################################
+# Compute the command to produce PCL code for validation process
+# 1. Update variables to specify which file to produce
+# 2. Update list of files to clean in later step
+# 3. Return the command to pass to an active backend
+sub vpcl_cmd {
+    my $self = shift ;
+
+    # Return empty string if we can use PCL from the previous step
+    return ""
+        if ( $self->{VDVILJOPT} =~ /^$self->{DVILJOPT}$/ and $self->do_pcl );
+
+    my $output = $self->{ID} . "-vpcl_cmd.output" ;
+    my $command = "cd '$self->{PATH}'; ( export LANG=C;" ;
+    # Update dvilj command options
+    my $DVILJOPT = '-c' . $self->{COPIES} . ' ' . $self->{VDVILJOPT} ;
+
+    if ( $ADDPCL_JOBNAME and $self->getjobname()
+    and $self->{VDVILJOPT} =~ /-J/) {
+        my $jobname = $self->getjobname() ;
+        $jobname =~ s/\s+/_/ ; # Check to keep no space in name
+        $DVILJOPT =~ s/-J/-J$jobname/ ;
+    }
+
+    if ( $ADDPCL_USERNAME and $self->getusername()
+    and $self->{VDVILJOPT} =~ /-U/) {
+        my $username = $self->getusername() ;
+        $username =~ s/\s+/_/ ; # Check to keep no space in name
+        $DVILJOPT =~ s/-U/-U$username/ ;
+    }
+
+    ###1
+    $self->{VPCLFILE} = $self->{OUTFILE} . ".vpcl";
+    $self->{VLPRFILE} = $self->{VPCLFILE} ;
+
+    ###2
+    $self->toclean( $self->{PATH} . "/" . $output ,
+        $self->{PATH} . "/" . $output , $self->{OUTFILE} . ".dvicopy" ,
+        $self->{VPCLFILE} , $self->{VLPRFILE} );
+
+    ###3
+    my $dvicmd = "$DVILJ -v $DVILJOPT -e$self->{VPCLFILE} " .
+        $self->{FILE} . ".dvicopy" ;
+    # Is dvicopy still passed on original latex output ?
+    if ( -e "$self->{PATH}/$self->{FILE}.dvicopy" ) {
+        $command .= $dvicmd
+
+    } else {
+        $command .= "if dvicopy $self->{FILE}.dvi $self->{FILE}.dvicopy ;" .
+            "then $dvicmd; else echo \"dvicopy error: \$?\" ; fi" ;
+    }
+    $command .= ") >$output 2>&1" ;
+
+    return $self->request( $command );
+}
+
+################################################################################
+# Call a function from AFPDS/PCL.pm that check PCL code if necessary
+# Here for the validation process
+sub valid_vpcl {
+    return
+        unless ( $_[0]->{STATE} == DONE
+        and $_[0]->{PCLFILE} ne $_[0]->{VPCLFILE} ); # Still validated
+    $_[0]->{STATE} = 5 if (&validate_pcl5($_[0]->{VPCLFILE}));
+}
+
+sub ps_cmd {
+    my $self = shift ;
+    my $output = $self->{ID} . "-ps_cmd.output" ;
+
+    $self->{LPRFILE} = $self->{OUTFILE} . ".ps" ;
+
+    $self->toclean( $self->{PATH} . "/" . $output , $self->{LPRFILE} );
+
+    return $self->request( "cd $self->{PATH}; LANG=C " .
+        "dvips -c $self->{COPIES} $self->{DVIPSOPT}" .
+        " -o $self->{FILE}.ps $self->{FILE} " .
+        " >$output 2>&1" );
+}
+
+sub lpr_cmd {
+    my $self = shift ;
+    my $cmd ;
+    my $output = $self->{PATH} . "/" . $self->{ID} . "-lpr_cmd.output" ;
+
+    # We not mark LPRFILE to clean has it has been marked to during PCL command
+    $self->toclean( $output );
+
+    # Agregate print when required, then return empty string to delay command
+    # in JobManager
+    if ( $AGREGATE_PRINT and -d $self->{JOBDIR} ) {
+        my $PCL5cluster = $self->{JOBDIR} .
+            "/" . $self->getdestid . "-lpr-cluster" ;
+
+        # Add to be erased if still not created
+        $self->todelete( $PCL5cluster ) unless ( -e $PCL5cluster );
+
+        $cmd = "cat $self->{LPRFILE} >>$PCL5cluster 2>>$output" ;
+        $self->count_pcl5();
+
+        # Really lpr that job only if there's no other job in sequence
+        unless ($self->next_in_sequence) {
+            my $len = $self->get_pcl5_count ;
+            my $PrintID = $self->geta2pjob . ( $len > 1 ? "-${len}_Jobs" : "" );
+            $PrintID .= '-' . $self->{DESTID} ;
+            $cmd .= " ; LANG=C lpr $self->{LPROPT} -J'$PrintID' $PCL5cluster" .
+                " >>$output 2>&1" ;
+        }
+
+    } else {
+        my $PrintID = $self->geta2pjob . '-' . $self->{DESTID} ;
+        $cmd = "LANG=C lpr $self->{LPROPT} -J'$PrintID' $self->{LPRFILE} " .
+            ">>$output 2>&1" ;
+    }
+    return $self->request($cmd);
+}
+
+sub vlpr_cmd {
+    my $self = shift ;
+    my $cmd ;
+    my $output = $self->{PATH} . "/" . $self->{ID} . "-lpr_cmd.output" ;
+
+    # We not mark VLPRFILE to clean has it has been marked to during PCL command
+    $self->toclean( $output );
+
+    # Agregate print when required, then return empty string to delay command
+    # in JobManager
+    if ( $AGREGATE_PRINT and -d $self->{JOBDIR} ) {
+        my $PCL5cluster = $self->{JOBDIR} .
+            "/" . $self->getdestid . "-vlpr-cluster" ;
+
+        # Add to be erased if still not created
+        $self->todelete( $PCL5cluster ) unless ( -e $PCL5cluster );
+
+        $cmd = "cat $self->{VLPRFILE} >>$PCL5cluster 2>>$output" ;
+        $self->count_pcl5();
+
+        # Really lpr that job only if there's no other job in sequence
+        unless ($self->next_in_sequence) {
+            my $len = $self->get_pcl5_count ;
+            my $PrintID = $self->geta2pjob . ( $len > 1 ? "-${len}_Jobs" : "" );
+            $PrintID .= '-' . $self->{DESTID} . '-validation' ;
+            $cmd .= " ; LANG=C lpr $self->{VLPROPT} -J'$PrintID' $PCL5cluster "
+                . ">>$output 2>&1" ;
+        }
+
+    } else {
+        my $PrintID = $self->geta2pjob . '-' . $self->{DESTID} . '-validation' ;
+        $cmd = "LANG=C lpr $self->{VLPROPT} -J'$PrintID' $self->{VLPRFILE} " .
+            ">>$output 2>&1" ;
+    }
+    return $self->request($cmd);
+}
+
+sub count_pcl5 {
+    my $self = shift ;
+    my $destid = $self->getdestid ;
+    return unless $destid ;
+
+    my $a2pjob ;
+    return unless ( $a2pjob = $self->a2pobj );
+
+    my $key = $self->isstep(8) ? 'PCL5COUNT' : 'VPCL5COUNT' ;
+    if (defined($a2pjob->{$key}->{$destid})) {
+        $a2pjob->{$key}->{$destid} ++ ;
+    } else {
+        $a2pjob->{$key}->{$destid} = 1 ;
+    }
+}
+
+sub get_pcl5_count {
+    my $self = shift ;
+    my $destid = $self->getdestid ;
+    return 0 unless $destid ;
+
+    my $a2pjob ;
+    return 0 unless ( $a2pjob = $self->a2pobj );
+
+    return $a2pjob->{$self->isstep(8)?'PCL5COUNT':'VPCL5COUNT'}->{$destid} ;
+}
+
+sub get_arch_file {
+    my $self = shift ;
+
+    # Return cached value
+    return $self->{ARCH_FILE} if (defined($self->{ARCH_FILE}));
+
+    my $current_arch_file = $self->{PATH} . "/" . $self->{FILE} . ".arch" ;
+    $self->{ARCHFILE} = $self->getPdfName() ; # Get same base as PDF file
+    $self->{ARCHFILE} =~ s/\.pdf$/.arch/ ; # replace .pdf extension with .arch
+
+    my $ok = 0 ;
+    if ( -s $current_arch_file
+    and ! -s $self->{PATH} . "/" . $self->{ARCHFILE} ) {
+        # Rename arch file as expected by archivage thread
+        rename $current_arch_file , $self->{PATH} . "/" . $self->{ARCHFILE}
+            and $ok ++ ;
+        $self->error( 10, "Can't rename arch file from '" . $current_arch_file .
+            "' to '" . $self->{ARCHFILE} . "': $!") unless $ok ;
+
+    } elsif ( ! -s $self->{PATH} . "/" . $self->{ARCHFILE} ) {
+        $self->error(10,"Required arch file to be renamed is empty")
+            if ( -e $current_arch_file );
+        $self->error(10,"Required arch file exists but is empty")
+            if ( -e $self->{PATH} . "/" . $self->{ARCHFILE} );
+        $self->error(10,"No required arch file exists");
+    }
+    return 0 unless $ok ;
+
+    # Clean arch file only if not debugging archivage
+    my $archname = $self->{PATH} . "/" . $self->{ARCHFILE} ;
+    $ARCH_DEBUG ? $self->tomove($archname,$archname . "_debug.txt")
+        : $self->toclean($archname) ;
+
+    # Cache the request
+    return $self->{ARCH_FILE} = $self->request( $archname );
+}
+
+sub do_clean_cmd {
+    my $self = shift ;
+    &UPSTAT('CHECK_DO_CLEAN');
+    # CLEAN_CMD not defined: we need to define it in clean_cmd
+    # else check the next command is not 'DONE' number
+    # Also no clean if we prefer PURGEFILES or no file is existing
+    # as we don't clean folders
+    return ( ! defined($self->{CLEAN_CMD})) ?
+        (($PURGEFILES or ! grep { -e $_ } $self->get2clean)? 0 : 1 )
+        :
+        ( $self->{CLEAN_CMD}->[0] =~ /^\d+$/ ?
+            ( $self->{CLEAN_CMD}->[0] == DONE ? 0 : 1 ) : 1 );
+}
+
+sub clean_cmd {
+    my $self = shift ;
+    my ( $ZipFile , $index ) = ( "" , 0 );
+
+    # Return next cached command
+    if (defined($self->{CLEAN_CMD})) {
+        &UPSTAT('MOVE_CMDS');
+        return shift @{$self->{CLEAN_CMD}} ;
+    }
+
+    # First delete empty files
+    map { ( unlink $_ and $self->jobdebug("'$_' file deleted as empty"))
+             if ( -z $_ and -f $_ ) } $self->get2clean ;
+
+    my @ToClean = grep { -s $_ and -f $_ } $self->get2clean ;
+    # Empty CLEAN array now to preserve memory on big jobs
+    $self->{CLEAN} = [ ] ;
+
+    # Find a free zipfile name, should loop only one time to set ZipFile name
+    while ( -e $ZipFile or ! $ZipFile ) {
+        $ZipFile = ($self->{ERROR} ? $ERRORSPOOL : $DONESPOOL ) . "/" .
+            $LOCKID . "-" . $self->{ID} . ($index++?"-$index":"") . ".zip" ;
+    }
+
+    # Return zipfile name to client
+    $self->jobinfo("ZIPFILE=$ZipFile") if ( $self->getClientRef );
+
+    # Keep ZIPFILE found if we need to attach it to an alert mail
+    $self->{ZIPFILE} = $ZipFile ;
+
+    while ( @ToClean ) {
+        my @files = () ;
+        my $max = $MAXFILES_BY_ZIPCMD || 10 ;
+        while ( $max -- and @ToClean ) {
+            push @files, &GetCom( comFILE , shift @ToClean );
+        }
+
+        push @{$self->{CLEAN_CMD}}, $self->request(
+            &GetCom( comZIP , $ZipFile => @files ));
+    }
+
+    # Keep debugging on commands
+    foreach my $zipcmd ( @{$self->{CLEAN_CMD}} ) {
+        $self->jobdebug("Have to do clean command using '$zipcmd' request");
+    }
+
+    # Keep commands number to initialize step 11 progression
+    $self->{NB_CMDS} += scalar(@{$self->{CLEAN_CMD}});
+
+    # Work around when nothing found to clean
+    push @{$self->{CLEAN_CMD}}, "" unless (@{$self->{CLEAN_CMD}});
+
+    # Add DONE status to the end of list, it will be seen by do_clean_cmd
+    push @{$self->{CLEAN_CMD}}, DONE ;
+
+    &UPSTAT('CLEAN_CMDS');
+    return shift @{$self->{CLEAN_CMD}} ;
+}
+
+sub clean_progress {
+    # Give info each 30 sec when clean step is longer than 30 sec
+    my $self = shift ;
+    return unless ($self->{NB_CMDS});
+    return unless ( $self->get_ms - $self->{NB_CMDS_CHECK} > 30000 );
+    return unless (defined($self->{CLEAN_CMD})
+        and ref($self->{CLEAN_CMD}) =~ /^ARRAY/i );
+    return unless (defined($self->{MOVE_CMDS})
+        and ref($self->{MOVE_CMDS}) =~ /^ARRAY/i );
+
+    $self->{NB_CMDS_UNIT} = 100 / $self->{NB_CMDS}
+        unless ( $self->{NB_CMDS_UNIT} > 0 );
+
+    $self->{NB_CMDS_CHECK} = $self->get_ms ;
+
+    my $ratio = $self->{NB_CMDS_UNIT} * ( $self->{NB_CMDS}
+        - scalar(@{$self->{MOVE_CMDS}})
+        - scalar(grep { defined and $_ ne DONE } @{$self->{CLEAN_CMD}}) );
+
+    $self->jobinfo(sprintf("Cleanning done at %.1f%%, should finish in %d sec",
+        $ratio ,
+        ( $self->{NB_CMDS_CHECK}/1000 ) * ( 100 / $ratio - 1 ) ));
+
+    $self->jobstatus( '.', { 'STATUS' => sprintf("%d%%", $ratio ) } )
+        or &Info("Can't set job progression status at step " . $self->{STEP});
+}
+
+sub jobstatus {
+    my $self = shift ;
+    my $step_status = shift ;
+    my $status = shift || {} ;
+    my $jobid  = $self->geta2pjob ;
+
+    if ($jobid) {
+        $status->{JID}  = $self->{ID} ;
+        $status->{STEP} = $self->{STEP} ;
+
+    } else {
+        $jobid = $self->getid ;
+    }
+
+    return &a2pjobstate( $jobid, $self->{STEP}, $step_status, $status );
+}
+
+sub a2pjob_progress_init {
+    my $self = shift ;
+    return unless ($self->{JOBS});
+
+    # 8 steps ( steps 3 to 10 ) can be done for each job
+    my $nb_steps = $self->{JOBS} * 8 ;
+    $self->{NB_STEPS_UNIT} = 100 / $nb_steps ;
+
+    # Many steps can still have been done before this initialization
+    $self->{NB_STEPS_OFFSET} = $self->{JOBS} * -2 ;
+    map { $self->{NB_STEPS_OFFSET} += $self->{CLONES_OBJ}->{$_}->{STEP} }
+        $self->getclones ;
+    $self->{NB_STEPS_OFFSET} += 10 * $self->getfinishedclones ;
+    $self->{NB_STEPS_OFFSET} *= $self->{NB_STEPS_UNIT} ;
+
+    $self->{NB_STEPS_CHECK} = 0 ;
+}
+
+sub a2pjob_progress {
+    my $self = shift ;
+    # Give info each 30 sec when main job is longer than 30 sec
+    return unless ( $self->get_ms - $self->{NB_STEPS_CHECK} > 30000 );
+
+    $self->{NB_STEPS_CHECK} = $self->get_ms ;
+
+    # Step count is calculated from step 2
+    my $ratio = $self->{JOBS} * -2 ;
+    map { $ratio += $self->{CLONES_OBJ}->{$_}->{STEP} } $self->getclones ;
+    $ratio += 10 * $self->getfinishedclones ;
+    $ratio *= $self->{NB_STEPS_UNIT} ;
+
+    # Must check we don't divide by zero
+    my $remain = ( $self->{NB_STEPS_CHECK} / 1000 ) *
+            ( 100 / ( $ratio > $self->{NB_STEPS_OFFSET} ?
+                $ratio - $self->{NB_STEPS_OFFSET} : 0.1 ) - 1 );
+    $self->jobinfo(sprintf("Progression done at %.1f%%, should finish in %d sec"
+        , $ratio , $remain ));
+
+    $self->jobstatus( '.', { STATUS => sprintf("%d%%", $ratio ) } )
+        or &Info("Can't set job progression status at step " . $self->{STEP});
+}
+
+my @todo_steps = (
+    "",
+    "",
+    "",
+    [ 'DO_PDF',                ], # Step 3
+    [ 'DO_PS' , 'DO_PCL',      ], # Step 4, do dvi
+    [ 'DO_PCL',                ], # Step 5 & 6
+    [ 'DO_PCL',                ], #
+    [ 'DO_PS' ,                ], # Step 7
+    [ 'DO_LPR',                ], # Step 8 & 9
+    [ 'DO_LPR',                ], #
+    [ 'DO_ARCH', 'DO_ESERVICE' ], # Step 10
+    );
+
+sub cancel {
+    my $self = shift ;
+    my $cancelled = 0 ;
+
+    # Cancel each job steps if still not at step 10
+    if ( $self->getstep < 10 ) {
+        foreach my $todo (grep { /^DO_/ } keys(%{$self})) {
+            if ( $self->{$todo} =~ /^yes$/i ) {
+                 $self->jobdebug("Cancelling $todo...");
+                 $self->{$todo} = 'cancelled' ;
+                 $cancelled ++ ;
+            }
+        }
+
+        return 0 unless ($cancelled);
+    }
+
+    # To cancel a job we need also to disable steps of each not finished subjobs
+    foreach my $job ( $self->getclones ) {
+        my $clone = $self->getclone($job) ;
+        my $step = $clone->getstep ;
+        my $this = 0 ;
+        while ( ++$step < 10 ) {
+            my @todo = @{$todo_steps[$step]} ;
+            my @steps_todo = grep { $clone->{$_} =~ /^yes|cancelled$/i } @todo ;
+            next unless @steps_todo ;
+            $clone->jobinfo("Cancelling @steps_todo at step $step");
+            map { $clone->{$_} = 'cancelled' } @steps_todo ;
+            $cancelled ++ ;
+            $this ++ ;
+        }
+        $clone->jobinfo("Nothing cancelled") unless ($this);
+    }
+
+    return 0 unless ($cancelled);
+
+    # Keep the cancel status
+    $self->cancelled(scalar(localtime(time)));
+
+    # Must return ourself if communications are pending
+    return $self ;
+}
+
+sub cancelled {
+    my $self = shift ;
+    $self->{CANCELLED} = shift if @_ ;
+    return exists($self->{CANCELLED}) ? 1 : 0 ;
+}
+
+sub canpurge {
+    my $self = shift ;
+    return $self->{CANPURGE} if defined($self->{CANPURGE});
+    $self->{CANPURGE} = 1 ;
+}
+
+sub cannotpurge {
+    my $self = shift ;
+    return ! $self->{CANPURGE} if defined($self->{CANPURGE});
+    $self->{CANPURGE} = 0 ;
+}
+
+sub purge {
+    my $self = shift ;
+    # Return cache value if still purged
+    return $self->{PURGE} if $self->{PURGE};
+    &UPSTAT('DO-PURGE');
+    return $self->{PURGE} = 1 if $self->cannotpurge ;
+
+    # Update files to purge when required
+    $self->todelete($self->get2clean) if $PURGEFILES ;
+
+    my %todel = map { $_ => -e $_ ? 1 : 0 } $self->get2delete ;
+    my @todel = grep { $todel{$_} } keys(%todel);
+    my $limit = @todel ;
+
+    local $" = ', ' ;
+    &Debug("Deleting @todel") if $ADVANCED_DEBUGGING ;
+
+    # Delete folders recursively if necessary
+    while ( grep { $todel{$_} } keys(%todel) and $limit -- ) {
+        foreach my $file ( keys(%todel) ) {
+            $! = 0 ;
+            if ( $todel{$file} and -e $file ) {
+                if ( -d $file ) {
+                    $self->jobdebug("Deleting '$file' folder")
+                        if $ADVANCED_DEBUGGING ;
+                    unless ( rmdir $file ) {
+                        $self->jobinfo("Failed to delete '$file' folder: $!")
+                            unless $limit ;
+                        next ;
+                    }
+
+                } elsif ( -f $file ) {
+                    &Debug("Deleting '$file' file") if $ADVANCED_DEBUGGING ;
+                    unless ( unlink $file ) {
+                        $self->jobinfo("Failed to delete '$file': $!")
+                            unless $limit ;
+                    }
+                }
+            }
+            $todel{$_} = 0 ;
+        }
+    }
+
+    @todel = grep { $todel{$_} } keys(%todel) ;
+    if (@todel) {
+        if ($ADVANCED_DEBUGGING) {
+            my %listing = () ;
+            # What to delete is probably a folder
+            foreach my $folder (@todel) {
+                map { $listing{$_} = 1 } glob( "$folder/*" ) ;
+            }
+            my @listing = keys( %listing );
+            &Debug("Job not cleaned, still not been removed: @todel");
+            &Debug("Job not cleaned, found in folders: @listing")
+                if @listing ;
+        }
+
+        return $self->{PURGE} = 0 ;
+
+    } else {
+        return $self->{PURGE} = 1 ;
+    }
+}
+
+sub freeparent {
+    my $self = shift ;
+
+    # To help freeing memory
+    $self->{PARENT} = undef ;
+}
+
+sub cleanjob {
+    my $self = shift ;
+    $self->{AGE} = sprintf("%.2f seconds", time - $self->{BIRTH});
+    undef $self->{CLEANHASH} ;
+    undef $self->{DELETEHASH} ;
+    undef $self->{MOVEHASH} ;
+    undef $self->{CLEAN} ;
+    undef $self->{DELETE} ;
+    undef $self->{MOVE} ;
+}
+
+sub DESTROY {
+    delete $uniqid{$_[0]->{ID}} ;
+    $_[0]->jobdebug("Freeing memory");
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
Index: /A2P/a2p/A2P/JobManager.pm
===================================================================
--- /A2P/a2p/A2P/JobManager.pm	(revision 3)
+++ /A2P/a2p/A2P/JobManager.pm	(revision 3)
@@ -0,0 +1,1318 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+package A2P::JobManager;
+
+# Derived class from Thread.pm
+use base qw(A2P::Thread);
+
+use strict ;
+use integer ;
+use Time::HiRes qw( gettimeofday tv_interval );
+use A2P::Globals ;
+use A2P::Syslog ;
+use A2P::Signal ;
+use A2P::Job ;
+use A2P::Thread ;
+use A2P::Com qw( IsCom GetCom comJOB comASK comSAY comDONE comINF
+               comREQ );
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 1399 $ =~ /(\d[0-9.]+)\s+/ ;
+}
+our $VERSION ;
+
+# Jobs management vars and subs
+my @Jobs ; # List of jobs waiting for an action
+my @SlowJobs ; # List of jobs waiting slowly for an action
+my %Jobs ; # List of current jobs objects, referenced by their current ID
+my %Cancels ; # List of cancelled jobs
+
+sub is_job {
+    return defined($_[0]) ?
+        ( ref($Jobs{$_[0]}) =~ /^A2P::Job$/ ? 1 : 0 ) : 0 ;
+}
+
+sub JobCount {
+    return grep {
+        defined($Jobs{$_}) and $Jobs{$_}->geta2pjob eq ""
+            and $Jobs{$_}->is_not_abterm
+            # Don't count splitted jobs as they are slower to handle
+            and ! $Jobs{$_}->is_splitted
+            and $Jobs{$_}->getstep < $CLEAN_OPTIMIZATION ? 11 : 13
+            and ! exists($Cancels{$_})
+        } keys(%Jobs);
+}
+
+sub ActiveJobCount {
+    return grep {
+        defined($Jobs{$_}) and $Jobs{$_}->geta2pjob eq "" and
+            $Jobs{$_}->is_not_abterm
+        } keys(%Jobs);
+}
+
+sub delete_job {
+    my $jid = shift ;
+    return unless (&is_job($jid));
+
+    # Check if we are deleting an AFP job
+    unless ( $Jobs{$jid}->geta2pjob ) {
+        # Empty waiting jobs list from the Jids
+        @Jobs = grep { $_ !~ /^$jid(-\d+){0,1}$/ } @Jobs ;
+        @SlowJobs = grep { $_->[0] !~ /^$jid(-\d+){0,1}$/ } @SlowJobs ;
+
+        # Delete clone objects before afpjob
+        map { delete $Jobs{$_} }
+            ( $Jobs{$jid}->getclones, $Jobs{$jid}->getfinishedclones );
+    }
+
+    delete $Jobs{$jid} ;
+}
+
+sub EnqueueJob {
+    my $jid = shift ;
+    return unless ( &is_job($jid) and ! grep { $_ eq $jid } @Jobs );
+    push @Jobs , $jid ;
+}
+
+sub SlowEnqueueJob {
+    my $jid = shift ;
+    return unless ( &is_job($jid) and ! grep { $_->[0] eq $jid } @SlowJobs );
+    my $factor = shift || 1 ;
+    &UPSTAT('SLOW-ENQUEUED');
+    $factor = 10 unless ( $factor < 10 );
+    &MAXSTAT('SLOW-QUEUE-FACTOR',$factor);
+    push @SlowJobs, [ $jid, [ &gettimeofday() ], $factor ] ;
+}
+
+################################################################################
+##             Job Manager code                                               ##
+################################################################################
+sub Do {
+    my $self = shift ;
+    my $ref  = shift ;
+
+    my $Ret = 0 ;
+
+    my @Job = &IsCom( comJOB , $$ref );
+
+    if ( @Job == 2 ) {
+        my ( $Jid , $Answer ) = @Job ;
+
+        &Debug("Received request for job '$Jid'");
+
+        if (defined($Jobs{$Jid})) {
+
+            if ( &IsCom( comINF , $Answer ) ) {
+                &UPSTAT('GET-COMINF');
+                my @infos = &IsCom( comINF , $Answer ) ;
+                my $info = join(": ",@infos);
+
+                # This information should return to client immediatly
+                if ( $Jobs{$Jid}->getClientRef() ) {
+                    # This is only some information during job processing
+                    $Jobs{$Jid}->jobdebug("Saying '$info' to " .
+                        $Jobs{$Jid}->getClientRef());
+                    $self->Request( Listener => &GetCom( comSAY ,
+                        $Jobs{$Jid}->getClientRef() => $info ) );
+
+                } elsif ( $infos[0] =~ /^ABTERM\s(\d+)$/i ) {
+                    $Jobs{$Jid}->error( $1, "ABTERM: " . $infos[1] );
+
+                } else {
+                    $Jobs{$Jid}->jobinfo($info);
+                }
+
+            } else {
+                # This is an expected answer
+                if ( $Answer =~ /^\d+$/ ) { # is_numeric
+                    $Jobs{$Jid}->setstate($Answer);
+
+                } else {
+                    $Jobs{$Jid}->setanswer($Answer);
+                }
+
+                # Update current pending requests number
+                if ($self->{PENDING_REQUEST}) {
+                    $self->{PENDING_REQUEST} -- ;
+                    &UPSTAT('pending-REQUEST',-1);
+                }
+
+                # Processing for this job
+                $Ret = $self->ManageJobs($Jid);
+
+            }
+            $Ret ++ unless $Ret ;
+
+        } else {
+            &Warn("Don't know anything of $Jid job in '$$ref' request");
+        }
+
+    } elsif ( $$ref =~ m|START|i ) {
+        if ( $SCAN_SPOOL ) {
+            &Debug("Starting to get files from spool");
+            $do_file ++ ;
+        }
+        $Ret = $self->Answer('STARTED');
+
+    # Is this a question ?
+    } elsif ( my @Ask = &IsCom( comASK , $$ref ) ) {
+        my $name = $Ask[0] ;
+        &Debug("Received question '$Ask[1]' from $name");
+
+        if ( @Job = &IsCom( comJOB , $Ask[1] )) {
+            # Prepare default returned value
+            my $thisjob = $Job[0] ;
+
+            # Check if it's a cancel request
+            if ( $Job[1] =~ /^cancel$/i ) {
+                &Debug("Got cancelling request for $thisjob job");
+                return $self->CancelJob( $name, $thisjob );
+            }
+
+            # Finally, create an a2p job and enqueue it in our job list
+            my $job = new A2P::Job( $thisjob , $name );
+
+            if ($job) {
+                $job->setstate(0);
+                $job->setanswer($Job[1]);
+                $job->setstep(0);
+                $job->start_ms
+                    and $job->nextstep("Got file to convert");
+
+                # Starting new job
+                $Jobs{$thisjob} = $job ;
+                $Ret = $self->ManageJobs($thisjob);
+
+            } else {
+                &Debug("Reporting error to $name");
+                $self->Request( Listener => &GetCom( comSAY ,
+                    $name => 'ABORTING RESTART ON RUNNING JOB' ) );
+                $self->Request( Listener => &GetCom( comSAY  ,
+                    $name => &GetCom( comDONE , '' => "JOBSTATUS: KO" ) ));
+
+                $Ret = $thisjob ;
+            }
+
+        } else {
+            $self->ThisError("[DEV] Unsupported '$Ask[1]' question from $name");
+        }
+
+    } else {
+        $self->ThisError("Got bad request '$$ref'");
+    }
+
+
+    return $Ret ;
+}
+
+sub CancelJob {
+    my $self = shift ;
+    my $name = shift ;
+    my $thisjob = shift ;
+
+    if (&is_job($thisjob)) {
+        &Info("trying to cancel $thisjob job as asked by $name");
+        if ( $Cancels{$thisjob} = $Jobs{$thisjob}->cancel ) {
+           $Cancels{$thisjob}->jobinfo("Cancel is pending");
+            $self->Request( Listener => &GetCom( comSAY ,
+                $name => 'CANCEL PENDING' ) );
+            $self->Request( Listener => &GetCom( comSAY  ,
+                $name => &GetCom( comDONE , '', "CANCEL: OK" ) ));
+
+        } else {
+            # Still delete this job if nothing more is expected
+            &delete_job($thisjob);
+            delete $Cancels{$thisjob} ;
+            $self->Request( Listener => &GetCom( comSAY ,
+                $name => 'CANCEL NOTHING OR TOO LATE' ) );
+            $self->Request( Listener => &GetCom( comSAY  ,
+                $name => &GetCom( comDONE , '', "CANCEL: KO" ) ));
+        }
+
+    } elsif (exists($Cancels{$thisjob})) {
+        &Debug("Can't cancel still cancelled $thisjob job");
+        $self->Request( Listener => &GetCom( comSAY ,
+            $name => 'STILL CANCELLING JOB' ) );
+        $self->Request( Listener => &GetCom( comSAY  ,
+            $name => &GetCom( comDONE , '', "CANCEL: OK" ) ));
+
+    } else {
+        &Warn("Can't cancel no more managed $thisjob job");
+        $self->Request( Listener => &GetCom( comSAY ,
+            $name => 'ABORTING CANCEL ON UNAVAILABLE JOB' ) );
+        $self->Request( Listener => &GetCom( comSAY  ,
+            $name => &GetCom( comDONE , '', "CANCEL: KO" ) ));
+    }
+
+    return $thisjob ;
+}
+
+my $lastcheck = [ &gettimeofday() ];
+sub GetRequest {
+    my $self     = shift ;
+    my $Requests = shift ;
+    my $Ret      = undef ;
+    my @JOBS ;
+
+    #######################
+    # Check flags
+    #######################
+
+    {
+        # Generate new job at SPOOL_TIME time
+        no integer ;
+        if ( &tv_interval($lastcheck) > $SPOOL_TIMER ) {
+            $lastcheck = [ &gettimeofday() ];
+            $do_file ++ ;
+        }
+    }
+
+    if ( $do_file and $SCAN_SPOOL ) {
+
+        @JOBS = &JobCount() ;
+        $STATS{'COUNTED-JOBS'} = "@JOBS" ;
+
+        if ( @JOBS < $MAXJOBS ) {
+            # Create an a2p job and enqueue it in our job list
+            my $job = new A2P::Job ;
+
+            # Enqueing new job
+            $Jobs{$job->getid} = $job ;
+            &EnqueueJob( $job->getid );
+
+            # Don't decrease do_file if many jobs are active as this means
+            # we can burst job creation as AFP files should be availables
+            $do_file -- unless ( &JobCount > 1 and &JobCount < $MAXJOBS );
+
+        } else {
+            &Debug("Skip new job creation as there's still enough job running");
+            $do_file -- ;
+        }
+    }
+
+    # Check to do some jobs and com for that jobs
+    $self->{DONTSLEEP} = 0 ;
+    $self->Request();
+    $self->ManageJobs();
+
+    @JOBS = &ActiveJobCount() ;
+    $STATS{'ACTIVES-JOBS'} = "@JOBS" ;
+    &MAXSTAT('ACTIVES-JOBS-COUNT',scalar(@JOBS));
+
+    # Really quit when MAXJOBS has been set to 0 and there's no more job running
+    $self->{DO_QUIT} = 1
+        unless ( $MAXJOBS
+        # Check if pending jobs are not cancelled
+        or ( @JOBS and @JOBS != grep { exists($Cancels{$_}) } @JOBS ));
+
+    return $MUSTQUIT ? 1 : $self->ReadSock($Requests) ;
+}
+
+sub ReturnInfoToClient {
+    # Return if not a client job
+    return unless $Jobs{$_[1]}->getClientRef() ;
+
+    # In case Job is requested by a client, send info to client
+    &Debug("Checking if $_[1] is a client to return to some info");
+    my @info = $Jobs{$_[1]}->getClientInfo ;
+    if ( @info ) {
+        my $Ref = shift @info ;
+        # Array becomes empty while there's no info
+        while ( @info ) {
+            my $info = shift @info ;
+            $Jobs{$_[1]}->jobdebug("Saying '$info' to $Ref");
+            $_[0]->Request( Listener => &GetCom( comSAY , $Ref => $info ) );
+        }
+    }
+
+    # Check if we need to close conversation
+    if ( $Jobs{$_[1]}->isstep(13) or
+            ( $Jobs{$_[1]}->isstep(12) and $Jobs{$_[1]}->getstate == DONE )) {
+        my $Ref = $Jobs{$_[1]}->getClientRef() ;
+        $Jobs{$_[1]}->unsetClientRef() ;
+        $_[0]->Request(
+            Listener => &GetCom( comSAY  ,
+                $Ref => &GetCom( comDONE , '' => "JOBSTATUS: " .
+                    ($Jobs{$_[1]}->error()?'KO':'OK') ) ));
+    }
+}
+
+sub loopdebug {
+    my $self = shift ;
+    &Debug("Current active jobs: " . &ActiveJobCount(),
+        "Current cached requests:",@{$self->{REQUESTS_ARRAY}});
+    $self->commonloopdebug();
+}
+
+sub ManageJobs {
+    my $self = shift ;
+    my $Jid  = shift ;
+
+    ####################################################################
+    # Check if we can get next job from SlowJobs list
+    ####################################################################
+    my $slowfactor = 0 ;
+    if ( @SlowJobs and ! defined($Jid) ) {
+        my $slowref = shift @SlowJobs ;
+        $Jid = $slowref->[0] ;
+        my @timeout = @{$slowref->[1]} ;
+        my $delay   = $slowref->[2]++ ;
+        $delay *= $USLEEP / 1_000_000 ;
+
+        # The rest of the array is a timer
+        if ( &tv_interval(@timeout) < $delay ) {
+            push @SlowJobs, $slowref ;
+            undef $Jid ;
+
+        } else {
+            # Set slowfactor in case we need it with SlowEnqueing
+            $slowfactor = $slowref->[2] ;
+        }
+    }
+
+    ##################################
+    # Get one Job Id if not a new one
+    ##################################
+    $Jid = shift @Jobs unless (defined($Jid));
+
+    return 1 unless $Jid ;
+
+    return &Warn("$Jid is not in my jobs list")
+        unless (&is_job($Jid));
+
+    # Compute a management rate for internal statistics
+    if ($self->{MANAGEJOBS_COUNT} ++
+    and &tv_interval($self->{MANAGEJOBS_TIME}) > 10 ) {
+        my $rate = $self->{MANAGEJOBS_COUNT} /
+            &tv_interval($self->{MANAGEJOBS_TIME}) ;
+        &MAXSTAT('MANAGEJOBS-RATE',sprintf("%.1f",$rate));
+        $self->{MANAGEJOBS_COUNT} = 0 ;
+        $self->{MANAGEJOBS_TIME} = [ &gettimeofday() ] ;
+    }
+
+    # As we have tasks to do, avoid to sleep on main loop
+    $self->{DONTSLEEP} ++
+        unless ($self->{LASTJOB} eq $Jid);
+
+    $self->{LASTJOB} = $Jid ;
+
+    my $Job = $Jobs{$Jid} ;
+
+    $self->ReturnInfoToClient( $Jid ) unless ($Job->isstep(12));
+
+    # Check if job is in an agregation error case to shorten processing
+    goto JOBDONE if ( $Job->badagregation and ! $Job->isstep(10) );
+
+    ############################################################################
+    # Step 0: Job just created, it need a file, so give it to SpoolManager
+    ############################################################################
+    if ( $Job->isstep(0) ) {
+        $Job->jobdebug("Starting Job $Jid with a2p v" . A2P_RPM_VERSION );
+        $Job->jobinfo("Checking one file from AFPSPOOL");
+        $Job->start_ms
+            and $Job->nextstep("Waiting for a filename");
+        $self->Request( SpoolManager => $Job->request );
+
+    ############################################################################
+    # Step 1: A2P Job returned with a filename or with NOMOREFILE
+    ############################################################################
+    } elsif ( $Job->isstep(1) ) {
+        $Job->stop_ms; # Stop chrono
+
+        if ( $Job->getstate == NOMOREFILE ) {
+            $Job->jobinfo("No file to convert");
+            $Job->releaseinfo ;
+            &delete_job($Jid);
+
+            &UPSTAT('NOAFPJOB');
+
+        } elsif ( $Job->getstate == 0 ) {
+            $Job->releaseinfo ;
+
+            # Have a file to convert
+            my $file = $Job->setfile( $Job->getanswer );
+            $Job->start_ms
+                and $Job->nextstep("Converting '$file' to TeX format");
+            $self->Request( Converter => $Job->toconverter );
+
+            # Also say to SpoolManager its job is done and we manage now here
+            # any information about the job and its AFP file
+            $self->Request( SpoolManager => $Job->request( DONE ))
+                if ( $SCAN_SPOOL and ! $Job->is_splitted ) ;
+
+            &UPSTAT('STARTEDAFPJOB');
+
+        } else {
+            $Job->jobalert( $Job->getstate,
+                "ABTERM: Can't get a file from AFPSPOOL");
+            $MUSTQUIT ++ ;
+        }
+
+    ############################################################################
+    # Step 2: A2P Job returned from a converter
+    ############################################################################
+    } elsif ( $Job->isstep(2) ) {
+
+        if ( $Job->getstate ) {
+            # Check if we need to split AFP file before stopping this step
+            my $do_split = $Job->split_cmd ;
+            if (defined($do_split)) {
+                if ($do_split =~ /^\d+$/) {
+                    if ($do_split) {
+                        $Job->error( $do_split, "ABTERM: Splitting error");
+
+                    } else {
+                        # Not ready to split, so process later
+                        &SlowEnqueueJob($Jid,$slowfactor);
+                    }
+
+                } else {
+                    $self->Request( BackEnd => $do_split );
+                }
+
+                # Still return when no error found in splitting
+                return 1 unless $Job->error ;
+            }
+
+            $Job->stop_ms; # Stop chrono
+
+            # Wait for all TeX jobs to be done
+            $Job->a2pjob_progress_init ;
+            $Job->start_ms
+                and $Job->setstep(10);
+
+            # Initializes sequence computation
+            $Job->sequence_ready();
+
+            if ($Job->getstate == DONE) {
+                $Job->jobinfo("Waiting after cloned job");
+
+            } else {
+                # Error
+                $Job->error( $Job->getstate, "ABTERM: Bad conversion")
+                    unless ( $Job->error >= 90 and $Job->error < 100 );
+                $Job->jobinfo("Waiting any cloned job after conversion ABTERM");
+
+                # Update files to clean
+                $Job->setconversionerrorcleaning ;
+            }
+
+            &EnqueueJob($Jid);
+
+        } else {
+            # Have a converted file, create a new job starting at step 3
+            # Or this is just a folder name to add in todelete list
+            # Or also it can be a split event
+            if ( -d $Job->getanswer ) {
+                $Job->setjobdir( $Job->getanswer );
+                return 1 ;
+            }
+
+            # Create a cloned job to continue steps
+            my $job = $Job->newjob() ;
+
+            # We reach a split event if job is undefined
+            unless (defined($job)) {
+
+                # Re-enqueue this job as it should be set DONE now
+                $Job->setstate(DONE);
+                &EnqueueJob($Jid);
+
+                # Get the tag to save this AFP as with Tag
+                my $tag    = $Job->{'SPLIT_TAG'}  ;
+                my $newtag = $Job->{'SPLIT_TAG2'} ;
+
+                # Then create an a2p job and enqueue it in our job list for the
+                # same file but starting at a given position
+                $job = new A2P::Job ;
+                $Jobs{$job->getid} = $job ;
+
+                # Initialize job from splitted job
+                $job->split_from( $Job );
+
+                # Starting new job by enqueing it
+                $job->setstep(0);
+                $job->start_ms
+                    and $job->nextstep("New AFP to convert $newtag jobs" .
+                        " from " . $job->getfilestart .
+                        " pos in original AFP file");
+
+                # Initialize jobstatus with AfpName to keep restarts in mind
+                # as step 1 done as if it was set by SpoolManager
+                my ( $AfpName ) = $Job->getfile =~ $AFPNAME_REGEX ;
+                $job->jobstatus( 'o',
+                    {
+                        AFP    => $AfpName.'.'.$newtag,
+                        JOBID  => $job->getid,
+                        STATUS => 'STARTING',
+                        FILE   => $Job->getfile.'.'.$newtag,
+                        INFOS  => 'Started'
+                    } )
+                    or &Info("Can't initialize '".$job->getid."' status");
+
+                &EnqueueJob($job->getid);
+
+                # Still return after handling the split
+                return 1 ;
+            }
+
+            &UPSTAT('STARTEDJOB');
+
+            $Job->jobdebug("Cloned as job " . $job->getid .
+                " to process " . $job->getfile );
+
+            my $jid = $job->getid ;
+            $Jobs{$jid} = $job ;
+
+            # Update job status now to set the DESTID
+            $job->jobstatus( '.',
+                {
+                    DESTID => $job->getdestid ,
+                    JOBNAME=> $job->getjobname ,
+                    STATUS => "STARTED"
+                })
+                or &Info("Can't set job status at step 3");
+
+            if ($job->do_pdf or $ONLY_DO_PDF) {
+                $job->start_ms
+                    and $job->nextstep("Generating PDF " .
+                        ( $job->getClientRef() ?
+                            "'" . $job->getPdfName() . "'" : "file" ));
+
+
+                $self->Request( BackEnd => $job->pdf_cmd );
+
+            } else {
+                $Job = $job ;
+                $Jid = $jid ;
+                $Job->stepskip("No pdf file required, skipped");
+                goto STEP4 ;
+            }
+        }
+
+    ############################################################################
+    # Step 3: Pdf file done or not needed, check to do DVI
+    ############################################################################
+    } elsif ( $Job->isstep(3) ) {
+        if ($Job->do_pdf or $ONLY_DO_PDF) {
+            # Still rename PDF to its final name
+            $Job->rename_pdf ;
+
+            $Job->stop_ms ; # Stop chrono
+
+            # Check state
+            if ( $Job->getstate != DONE ) {
+                $Job->error( $Job->getstate, "ABTERM: Bad PDF generation");
+                # Any error disable next processing, see A2P::Job->error
+
+                # We must also set an error to diasable any sequence processing
+                $Job->error( 701, "Aborting the printing sequence" );
+
+            } else {
+                $Job->stepdone ;
+            }
+
+            # Finish immedialy this job if needed
+            if ( $ONLY_DO_PDF ) {
+                $Job->setstep(10);
+                goto JOBDONE  ;
+            }
+        }
+STEP4:
+        if ($Job->do_pcl or $Job->do_vpcl or $Job->do_ps) {
+            $Job->start_ms
+                and $Job->nextstep("Converting to DVI format");
+            $self->Request( BackEnd => $Job->dvi_cmd );
+
+        } else {
+            $Job->stepskip("No dvi format required, skipped");
+            # Nothing to print so jump directly to step 10
+            $Job->setstep(9);
+            goto STEP10 ;
+        }
+
+    ############################################################################
+    # Step 4: DVI file done or not needed, check to do PCL
+    ############################################################################
+    } elsif ( $Job->isstep(4) ) {
+        if ($Job->do_pcl or $Job->do_vpcl or $Job->do_ps) {
+            $Job->stop_ms ; # Stop chrono
+
+            # Check state
+            if ( $Job->getstate != DONE) {
+                $Job->error($Job->getstate,"ABTERM: Bad DVI format conversion");
+                # Any error disable next processing, see A2P::Job->error
+
+            } else {
+                $Job->stepdone ;
+            }
+        }
+STEP5:
+        if ($Job->do_pcl) {
+            $Job->start_ms
+                and $Job->nextstep("Generating PCL format");
+            $self->Request( BackEnd => $Job->pcl_cmd );
+
+        } else {
+            $Job->stepskip("No pcl format required, skipped");
+            goto STEP6 ;
+        }
+
+    ############################################################################
+    # Step 5: PCL file done or not needed, check to do VPCL
+    ############################################################################
+    } elsif ( $Job->isstep(5) ) {
+        if ($Job->do_pcl) {
+            $Job->valid_pcl; # Check PCL file
+            $Job->stop_ms ; # Stop chrono
+
+            # Check state
+            if ( $Job->getstate != DONE) {
+                $Job->error($Job->getstate,"ABTERM: Bad PCL format generation");
+                # Any error disable next processing, see A2P::Job->error
+
+            } else {
+                $Job->stepdone ;
+            }
+        }
+STEP6:
+        if ($Job->do_vpcl) {
+            my $vpcl_cmd = $Job->vpcl_cmd ;
+
+            # Only ask to generate vpcl if we need a different pcl than previous
+            if ( $vpcl_cmd ) {
+                $Job->start_ms
+                    and $Job->nextstep("Generating PCL format for validation");
+                $self->Request( BackEnd => $vpcl_cmd );
+
+            } else {
+                $Job->stepskip("Validation PCL still generated " .
+                    "during previous step");
+                goto STEP7 ;
+            }
+
+        } else {
+            $Job->stepskip("No validation pcl file required, skipped");
+            goto STEP7 ;
+        }
+
+    ############################################################################
+    # Step 6: VPCL file done or not needed, check to do PS
+    ############################################################################
+    } elsif ( $Job->isstep(6) ) {
+        if ($Job->do_vpcl) {
+            $Job->valid_vpcl; # Check PCL file
+            $Job->stop_ms ; # Stop chrono
+
+            # Check state
+            if ( $Job->getstate != DONE) {
+                $Job->error( $Job->getstate,
+                    "ABTERM: Bad PCL format for validation");
+                # Any error disable next processing, see A2P::Job->error
+
+            } else {
+                $Job->stepdone ;
+            }
+        }
+STEP7:
+        if ($Job->do_ps and ! $Job->do_pcl) {
+            $Job->start_ms
+                and $Job->nextstep("Generating PS format");
+            $self->Request( BackEnd => $Job->ps_cmd );
+
+        } else {
+            $Job->stepskip("No PS file required, skipped");
+            $Job->jobinfo("DESTID is " . $Job->getdestid ) if ($Job->getdestid);
+            goto STEP8 ;
+        }
+
+        $Job->jobinfo("DESTID is " . $Job->getdestid ) if ($Job->getdestid);
+        &EnqueueJob($Jid);
+
+    ############################################################################
+    # Step 7: PS file done or not needed, check to do PRINT
+    ############################################################################
+    } elsif ( $Job->isstep(7) ) {
+        if ($Job->do_ps and ! $Job->do_pcl and $Job->stepnotdone) {
+            $Job->stop_ms ; # Stop chrono
+
+            # Check state
+            if ( $Job->getstate != DONE) {
+                $Job->error( $Job->getstate, "ABTERM: Bad PS format");
+                # Any error disable next processing, see A2P::Job->error
+
+            } else {
+                $Job->stepdone ;
+            }
+        }
+STEP8:
+        my $later = 0 ;
+        # do_lpr must be in sequence
+        if ($Job->do_lpr(\$later)) {
+            $Job->start_ms
+                and $Job->nextstep( ( $Job->next_in_sequence ?
+                    "Agregating for " : "Printing to " ) . $Job->printer );
+            $self->Request( BackEnd => $Job->lpr_cmd );
+
+        # Just enqueue again this job step if not its turn
+        } elsif ($later) {
+            $Job->jobdebug("Waiting for print sequence");
+            # Set it waiting if the sequence is known as this means this is not
+            # our turn to print
+            if ($Job->sequence_ready()) {
+                return $Job->waiting(1);
+
+            } else {
+                &EnqueueJob($Jid);
+            }
+
+        } else {
+            if ($Job->error) {
+                # Need to check sequence if we pass here after a error in the
+                # middle of a sequence
+                &EnqueueJob( $Job->get_next_authorized )
+                    if ( $Job->remove_from_sequence_but_authorize_next );
+            }
+
+            $Job->stepskip("No print required, skipped");
+            goto STEP9 ;
+        }
+        # Here the job is not waiting
+        $Job->waiting(0);
+
+    ############################################################################
+    # Step 8: Print done or not needed, check to do VPRINT
+    ############################################################################
+    } elsif ( $Job->isstep(8) ) {
+        if ($Job->do_lpr and $Job->stepnotdone) {
+            $Job->stop_ms ; # Stop chrono
+
+            # Print is in the print spool we can authorize next print
+            # in the sequence
+            &EnqueueJob( $Job->get_next_authorized )
+                if ( $Job->authorize_next_print and $Job->next_is_waiting );
+
+            # Check state
+            if ( $Job->getstate != DONE ) {
+                $Job->error( $Job->getstate, "ABTERM: Print Error");
+                # Any error disable next processing, see A2P::Job->error
+
+            } else {
+                $Job->stepdone ;
+            }
+        }
+STEP9:
+        my $later = 0 ;
+        if ($Job->do_vlpr(\$later)) {
+            $Job->start_ms
+                and $Job->nextstep( ( $Job->next_in_sequence ?
+                    "Agregating validation for " : "Printing for validation to "
+                    ) . $Job->vprinter );
+            $self->Request( BackEnd => $Job->vlpr_cmd );
+
+        # Just enqueue again this job step if not its turn
+        } elsif ($later) {
+            $Job->jobdebug("Waiting for validation print sequence");
+            # Set it waiting if the sequence is known as this means this is not
+            # our turn to print
+            if ($Job->sequence_ready()) {
+                return $Job->waiting(1);
+
+            } else {
+                &EnqueueJob($Jid);
+            }
+
+        } else {
+            if ($Job->error) {
+                # Need to check sequence if we pass here after a error in the
+                # middle of a sequence
+                &EnqueueJob( $Job->get_next_authorized )
+                    if ( $Job->remove_from_sequence_but_authorize_next );
+            }
+
+            $Job->stepskip("No validation print required, skipped");
+            goto STEP10 ;
+        }
+        $Job->waiting(0);
+
+    ############################################################################
+    # Step 9: VPrint done or not needed, check to archive
+    ############################################################################
+    } elsif ( $Job->isstep(9) ) {
+
+        if ($Job->do_vlpr) {
+            $Job->stop_ms ; # Stop chrono
+
+            # Print is in the print spool we can authorize next print
+            # in the sequence
+            &EnqueueJob( $Job->get_next_authorized )
+                if ( $Job->authorize_next_print and $Job->next_is_waiting );
+
+            # Check state
+            if ( $Job->getstate != DONE ) {
+                $Job->error( $Job->getstate, "ABTERM: Validation Print error");
+                # Any error disable next processing, see A2P::Job->error
+
+            } else {
+                $Job->stepdone ;
+            }
+        }
+STEP10:
+        if ($Job->do_arch) {
+            $Job->start_ms
+                and $Job->nextstep("Archiving PDF file");
+
+            if ( $Job->get_arch_file ) {
+                $self->Request( Archiver => $Job->get_arch_file );
+
+            } else {
+                $Job->error( 110,
+                    "Need to archive something but not arch base available");
+                goto JOBDONE ;
+            }
+
+        } elsif ($Job->do_eservice) {
+            $Job->start_ms
+                and $Job->nextstep("Transmitting PDF file to '" .
+                    $Job->eservice_name . "'");
+
+            if ( $Job->eservice_request ) {
+                $self->Request( EService => $Job->eservice_request );
+
+            } else {
+                $Job->error( 110,
+                    "Need to transmit something but no content available");
+                goto JOBDONE ;
+            }
+
+        } else {
+            $Job->stepskip("No archiving required, skipped");
+            goto JOBDONE ;
+        }
+
+    ############################################################################
+    # Step 10: Waiting for cloned job to be processed
+    ############################################################################
+    } elsif ( $Job->isstep(10) ) {
+JOBDONE:
+        my $a2pjob = $Job->geta2pjob ;
+
+        #-------------------------------------------------
+        # It's cloned job waited after by its A2P job
+        #-------------------------------------------------
+        if (length($a2pjob)) {
+
+            if ($Job->do_arch) {
+                $Job->stop_ms ; # Stop chrono
+
+                # Check state
+                if ( $Job->getstate != DONE ) {
+                    $Job->error( $Job->getstate, "ABTERM: Archiver error");
+                    # Any error disable next processing, see A2P::Job->error
+
+                } else {
+                    $Job->stepdone ;
+                }
+
+                # Check if we need to pass again to step 10 for E-Service...
+                if ($Job->do_eservice) {
+                    $Job->setstep(9) ;
+                    goto STEP10 ;
+                }
+
+            } elsif ($Job->do_eservice) {
+                $Job->stop_ms ; # Stop chrono
+
+                # Check state
+                if ( $Job->getstate != DONE ) {
+                    $Job->error( $Job->getstate, "ABTERM: '" .
+                        $Job->eservice_name . "' E-Service error");
+                    # Any error disable next processing, see A2P::Job->error
+
+                } else {
+                    $Job->stepdone ;
+                }
+            }
+
+            if (defined($Jobs{$a2pjob})) {
+                # Check error to update a2pjob error state
+                $Jobs{$a2pjob}->error( $Job->error,
+                    "Cloned job $Jid gives error on step " .
+                    $Job->getsteperror . ": " . join(', ',$Job->geterrors))
+                        if ($Job->error);
+
+                # Update parent job even if any other clone produced error
+                $Jobs{$a2pjob}->todelete($Job->get2delete);
+                $Jobs{$a2pjob}->toclean($Job->get2clean);
+                $Jobs{$a2pjob}->tomove($Job->get2move);
+
+            } else {
+                $Job->error( 10 , "AFPFile job object has been released" );
+            }
+
+            # Keep statistics from this job before delete it
+            $Job->setstate( $Job->error ? $Job->error : DONE );
+            $self->KeepStats( $Job->getstatistics() );
+
+            # Now we can destroy the clone as we kept all needed information
+            $self->ReturnInfoToClient( $Jid );
+
+            # Freeing job and sanity
+            $Jobs{$a2pjob}->jobdone($Job) if (defined($Jobs{$a2pjob}));
+            $Job->freeparent ;
+            &delete_job($Jid);
+
+            &UPSTAT('RELEASEDJOB');
+
+        #--------------------------------------------
+        # It's a waiting A2P job
+        #--------------------------------------------
+        } else {
+            if ( $Job->nomorejob ) {
+                #
+                # Cloned jobs are finished
+                #
+                $Job->stop_ms; # Stop chrono
+
+                $Job->stepdone ;
+
+                # Release memory of clones unless error are present to keep a
+                # dump of them in sent alert
+                $Job->clearjobsdone unless $Job->error ;
+
+                $Job->start_ms
+                    and $Job->nextstep("Cleaning environment");
+
+                # Preparing to convert another file immediatly, not waiting the
+                # previous job to be cleaned
+                $do_file ++ if $CLEAN_OPTIMIZATION ;
+
+            } else {
+                $Job->a2pjob_progress ;
+            }
+
+            &EnqueueJob($Jid);
+        }
+
+    ############################################################################
+    # Step 11: Environment is clean, next is to purge
+    ############################################################################
+    } elsif ( $Job->isstep(11)) {
+
+        # Check to send a move command
+        if ($Job->do_move_cmd) {
+            my $cmd = $Job->move_files_cmd || "" ;
+            # Send now any non empty move command if not still done
+            if ($cmd){
+                $self->Request( BackEnd => $cmd );
+                &UPSTAT('MOVE_CMDS');
+            } else {
+                &EnqueueJob($Jid);
+                &UPSTAT('BAD_MOVE_CMDS');
+            }
+
+        } elsif ( $Job->do_clean_cmd ) {
+            my $cmd = $Job->clean_cmd || "" ;
+            # Send now any clean command if not still done
+            if ($cmd) {
+                $self->Request( BackEnd => $cmd );
+                &UPSTAT('CLEAN_CMDS');
+            } else {
+                &EnqueueJob($Jid);
+                &UPSTAT('BAD_CLEAN_CMDS');
+            }
+
+        } else {
+            # Cleaning is finished
+            $Job->stop_ms; # Stop chrono
+
+            if ( $Job->getstate != DONE ) {
+                $Job->error( $Job->getstate, "ABTERM: Error while cleaning");
+                $Job->cannotpurge ;
+
+            } else {
+                $Job->canpurge ;
+                $Job->stepdone ;
+            }
+
+            $Job->start_ms
+                and $Job->nextstep("Purging environment");
+            return &EnqueueJob($Jid);
+        }
+
+        # Check to return progression for long job
+        $Job->clean_progress ;
+
+    ############################################################################
+    # Step 12: Try to purge environment and delete job
+    ############################################################################
+    } elsif ( $Job->isstep(12) ) {
+
+        if ($Job->purge or $Job->getpurgetry == 0) {
+            $Job->error(112, "ABTERM: Error while purging" . (($!)?" ($!)":""))
+                unless $Job->purge ;
+
+            $Job->stop_ms; # Stop chrono
+            $Job->setstate( DONE );
+
+            # Keep statistics from this job before delete it
+            $self->KeepStats( $Job->getstatistics() );
+
+            # Anyway step is done
+            $Job->stepdone ;
+
+            if ( $Job->error ) {
+                # Check to do alert
+                $Job->jobalert ;
+
+                # Now we can release memory
+                $Job->clearjobsdone ;
+
+                &UPSTAT('ABTERM');
+
+            } else {
+                &UPSTAT('RELEASEDAFPJOB');
+            }
+
+            $self->ReturnInfoToClient( $Jid );
+            &delete_job($Jid);
+
+            # Manage case used in tests & diagnostics to stop service after
+            # a JOB_COUNTDOWN has been reached
+            &UPSTAT('JOBDONE');
+            if ($JOBS_COUNTDOWN) {
+                if ($STATS{'JOBDONE'} >= $JOBS_COUNTDOWN) {
+                    &Info("Countdown of $JOBS_COUNTDOWN jobs reached");
+                    # Ask maintid to stop
+                    kill 15, $maintid ;
+
+                } else {
+                    my $ratio = int(($STATS{'JOBDONE'}*100) / $JOBS_COUNTDOWN) ;
+                    unless ( ! $ratio or exists($STATS{'RATIO-'.$ratio})
+                    or $ratio % 10) {
+                        $STATS{'RATIO-'.$ratio} = localtime(time) ;
+                        &Info("Process of $JOBS_COUNTDOWN jobs countdown: ".
+                            sprintf('%02d%%',$ratio));
+                    }
+                }
+            }
+
+            return $Job->error ? 0 : 1 ;
+
+        } else {
+            # This can occur when zip file command is not finished and some
+            # files to clean are still in a folder to purge
+            $Job->jobdebug("Environment still not purged for Job $Job");
+
+            # Trying to purge later
+        }
+        &EnqueueJob($Jid);
+
+    ############################################################################
+    # Bad job
+    ############################################################################
+    } else {
+        $Job->error(5,"ABTERM: Don't know what to do");
+
+        # Check to do alert
+        $Job->jobalert ;
+        $self->ReturnInfoToClient( $Jid );
+
+        &delete_job($Jid);
+
+        &UPSTAT('ABTERM');
+
+        return 0 ;
+    }
+    return 1 ;
+}
+
+sub ThreadInit {
+    my $self = shift ;
+
+    # Initializes stat headers
+    $self->{STATHEADERS} = [ qw(
+        Date    DayTime     Jobname  DestId      SubStatus  Status
+        Errors  A2P-Chrono  LockId   Job-Timing  ) ];
+
+    $self->{HAVE_STATS} = 1 ;
+
+    # Other initialization
+    $self->{PENDING_REQUEST} = $self->{MANAGEJOBS_COUNT} = 0 ;
+    $self->{REQUESTS_ARRAY}  = [] ;
+    $self->{PENDING_LIMIT}   = 10 ;
+    $self->{PENDING_TIMING}  = $self->{MANAGEJOBS_TIME} = [ &gettimeofday() ];
+}
+
+sub InitUpdated {
+    my $self = shift;
+
+    # Garanty pending limit is greater than zero and not excessive
+    $self->{PENDING_LIMIT} = $MAXJOBS +
+        ( $MAXJOBS ? $BACKEND_FACTOR * $MAXJOBS : 10 );
+}
+
+sub Request {
+    # Modified Request to limit the rate of request relative to the number
+    # of Backends
+    my $self = shift ;
+
+    &MAXSTAT('pending-REQUEST',$self->{PENDING_REQUEST});
+
+    return unless ( @_ or @{$self->{REQUESTS_ARRAY}} );
+
+    if ( @_ ) {
+        &Debug("Caching '@_'")
+            if ( ! $NO_SYSLOG_DEBUG and @{$self->{REQUESTS_ARRAY}} );
+        push @{$self->{REQUESTS_ARRAY}}, \@_ ;
+
+        # Update current pending requests number
+        $self->{PENDING_REQUEST} ++ unless ( $_[0] eq 'Listener' );
+    }
+
+    while ( $self->{PENDING_REQUEST} < $self->{PENDING_LIMIT} or
+    rand $self->{PENDING_LIMIT} < &tv_interval($self->{PENDING_TIMING})) {
+        # The rand test allow sending new request even when there is none
+        # This guaranty a request will be send sometime by just calling this sub
+        # So we can call it regularily on a time basis to not forget any request
+
+        my $ref = shift @{$self->{REQUESTS_ARRAY}} ;
+        last unless (defined($ref));
+        next unless @{$ref} ;
+
+        my $req = &GetCom( comREQ , @{$ref} );
+        &Debug("Requesting '$req'");
+        $self->Answer( $req );
+        &UPSTAT('ASKED-REQUESTS');
+
+        $self->{PENDING_TIMING} = [ &gettimeofday() ];
+        $STATS{'LAST-PENDING-REQUEST'} = "@{$ref}" ;
+
+        # Keep state we have some new tasks for other jobs to do in the next
+        # loops as we have been able to transmit pending request
+        $self->{DONTSLEEP} ++ ;
+    }
+
+    &MAXSTAT('cached-REQUEST',scalar(@{$self->{REQUESTS_ARRAY}}));
+}
+
+sub DoBeforeQuit {
+    my $self = shift ;
+
+    return 1 unless ( $SCAN_SPOOL and $KEEP_JOBSTATUS );
+
+    my $alerted = "" ;
+
+    &Debug("Still known jobs: " . join(' ',keys(%Jobs))) if (keys(%Jobs));
+    # Get JIDs in SlowJobs list
+    push @Jobs, map { shift @{$_} } @SlowJobs if @SlowJobs ;
+    &Debug("Was about to process jobs: @Jobs") if @Jobs ;
+    &Debug("Still active jobs: " . join(' ',&ActiveJobCount()))
+        if (&ActiveJobCount());
+
+    # Set status to aborted to any existing job not in ABTERM
+    foreach my $Jid ( keys(%Jobs) ) {
+
+        unless (&is_job($Jid)) {
+            &delete_job($Jid);
+            &Warn("Forgetting status of deleted $Jid job");
+            next ;
+        }
+
+        my $Job = $Jobs{$Jid} ;
+
+        # Only steps saying we are managing an AFP file are significant
+        if ( $Job->isstep(0)
+        or ($Job->isstep(1) and $Job->getstate == NOMOREFILE )) {
+            &Debug("Job $Jid can't involve a conversion");
+            &delete_job($Jid);
+            next ;
+        }
+
+        my $alert = "Job $Jid was aborted " ;
+        if ($Job->isstep(1)) {
+            if ( $Job->getanswer and -e $Job->getanswer ) {
+                $alert .= "with a file to convert" ;
+
+            } else {
+                $alert .= "without knowing if a file is to be converted" ;
+            }
+
+        } elsif ($Job->isstep(2)) {
+            $alert .= "during TeX conversion" ;
+
+        } elsif ($Job->isstep(3)) {
+            $alert .= "during PDF conversion" ;
+
+        } elsif ($Job->isstep(4)) {
+            $alert .= "during DVI conversion" ;
+
+        } elsif ($Job->isstep(5) or $Job->isstep(6)) {
+            $alert .= "during PCL conversion" ;
+
+        } elsif ($Job->isstep(7)) {
+            $alert .= "during PS conversion" ;
+
+        } elsif ($Job->isstep(8) or $Job->isstep(9)) {
+            $alert .= "during Printing step" ;
+
+        } elsif ($Job->isstep(10) and $Job->geta2pjob()) {
+            $alert .= "during Archiving step" ;
+
+        } elsif ($Job->isstep(10)) {
+            $alert .= "waiting after sub jobs" ;
+
+        } elsif ($Job->isstep(11)) {
+            $alert .= "during cleaning step" ;
+
+        } elsif ($Job->isstep(12)) {
+            $alert .= "during purging step" ;
+
+        } elsif ($Job->error) {
+            # If we came here, an alert should still has been sent for this job
+            &Warn("Job $Jid in error aborted");
+            &delete_job($Jid);
+            next ;
+
+        } else {
+            $alert .= "in an unknown state" ;
+        }
+
+        $Job->jobstatus( 'A', { STATUS => 'KO', INFOS  => 'Aborted' } )
+            or &Info("Can't update aborted '$Jid' status");
+
+        $Job->cleanjob ;
+
+        $JOB_DUMP_ON_ERROR = 1 ; # Force the dump of the job object
+        $Job->jobalert( $alert );
+        $alerted .= ($alerted?" ":"") . $Jid ;
+
+        &delete_job($Jid);
+    }
+
+    &Debug($alerted?"Alerts sent for $alerted jobs":"No alert sent");
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
Index: /A2P/a2p/A2P/JobStatus.pm
===================================================================
--- /A2P/a2p/A2P/JobStatus.pm	(revision 3)
+++ /A2P/a2p/A2P/JobStatus.pm	(revision 3)
@@ -0,0 +1,1108 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Some job status subfunctions callable from a2p, a2p-status and webmin modules
+#
+
+package A2P::JobStatus ;
+
+use strict;
+use Fcntl;
+use Time::HiRes qw( usleep gettimeofday tv_interval) ;
+use Fcntl qw(:flock F_SETLK F_WRLCK SEEK_SET);
+use File::stat;
+use IO::Socket;
+use GDBM_File;
+use A2P::Globals ;
+use A2P::Syslog ;
+use A2P::Status ;
+use A2P::Tools qw( SharedList FreeSharedList ms );
+
+BEGIN {
+    use Exporter ();
+    our ( $VERSION , @ISA , @EXPORT_OK );
+
+    $VERSION = sprintf "%s", q$Rev: 986 $ =~ /(\d[0-9.]+)\s+/ ;
+
+    @ISA = qw(Exporter);
+    @EXPORT_OK = qw(
+        &sync_dbm_to_db &a2pjobstate &otherjobstate &getstatus_from_db
+        &get_status
+        );
+}
+our $VERSION ;
+
+my %TIED_STATUS = () ;    # Tied hash
+my %STATUS      = () ;    # Status object cache
+
+my $LCK ;
+my $CURRENTMODE = 0 ;                     # Access mode to tie: 0 = RO, 1 = R/W
+
+sub _freezed_status_re {
+    qr/^\x04.*A2P::Status/
+}
+
+sub _get_tied_ref {
+    return \%TIED_STATUS ;
+}
+
+sub _not_tied {
+    return tied(%TIED_STATUS) ? 0 : 1 ;
+}
+
+sub _get_cache_ref {
+    return \%STATUS ;
+}
+
+sub cansavetied {
+    $CURRENTMODE = 0 if _not_tied ;
+    return $CURRENTMODE ;
+}
+
+sub a2pjobstate {
+    return 1 unless ( $SCAN_SPOOL and $KEEP_JOBSTATUS );
+    &TIMESTAT('UPDATE-JOBSTATE');
+
+    my $ret = &tied_update_status(@_);
+
+    # 9. Call the cache cleaner after the status is updated
+    &cache_cleaner() ;
+
+    &TIMESTAT('UPDATE-JOBSTATE');
+    return $ret ;
+}
+
+sub otherjobstate {
+    # Check gdbm file exists before update specially if we are root !!! to
+    # avoid create an unreadable gdbm file for services
+    return 0 unless -e &dbm_base . $LOCKID ;
+    return &tied_update_status(@_);
+}
+
+sub newstatus_dbm_base {
+    return $SHMDIR . '/.new-status-' ;
+}
+
+sub dbm_base {
+    return $SHMDIR . '/.jobstatus-' ;
+}
+
+sub dbm_lock {
+    my $file = shift ;
+    my $lockid = shift || $LOCKID ;
+
+    return &Error("Can't open lock file to update $file job status: $!")
+       unless (open($LCK, '>', $file.'.LCK'));
+
+    my $tries = 0 ;
+    while ( $tries < 5 ) {
+        # Lock status update as only one thread should update status at a time
+        if (flock($LCK, LOCK_EX | LOCK_NB)) {
+            &MAXSTAT('STATUS-LOCK-RETRY',$tries);
+            return 1 ;
+        }
+        usleep $USLEEP >> 2 ;
+        $tries ++ ;
+    }
+    close($LCK);
+    undef $LCK ;
+    &MAXSTAT('STATUS-LOCK-RETRY',$tries);
+    return 0 ;
+}
+
+sub dbm_unlock {
+    my $lockid = shift || $LOCKID ;
+    return 1 unless (defined($LCK));
+
+    flock($LCK, LOCK_UN);
+    $CURRENTMODE = 0 ;
+    close($LCK);
+    undef $LCK ;
+
+    # Key used by A2P::Status API to know if it can write to tiehash
+    delete $STATUS{__GDBM_WRITER__};
+
+    1 ;
+}
+
+my $search_status = '' ;
+sub get_status {
+    my $name = shift ;
+    my ( $key, $status, $found ) = ( '', 0, '' );
+
+    # Parse each status in cache
+    foreach (( $key, $status ) = each(%STATUS)) {
+        next unless (&is_status($status));
+        if ($status->is_job eq $name or $status->{JOBID} eq $name
+        or $status->{AFP} eq $name) {
+            $found = $key ;
+            last ;
+        }
+    }
+
+    # Set we are searching for this job for next list scan if not found
+    if ($found) {
+        $search_status = '' unless ( $search_status ne $name );
+
+    } else {
+        &StatusDebug("Searching for status object of $name");
+        $search_status = $name ;
+        $status = 0 ;
+    }
+
+    return $status ;
+}
+
+my @sync_list = ( {}, {}, {}, {} ) ; # Array of 4 hash refs
+# 0 -> Lists to sync cache by lockid (keys like __.*__ are based on cache keys)
+# 1 -> Lists of expected keys to be synchronised
+# 2 -> Lists of timer for resynchronization
+# 3 -> Lists of keys to recheck as writer
+sub sync_list {
+    # Return a given number of element to check in sync_cache API
+    my $lockid = shift || $LOCKID ;
+
+    my ( $lists, $shorts, $timings ) = @sync_list ;
+
+    $lists->{$lockid} = [] unless (exists($lists->{$lockid}));
+    my $list = $lists->{$lockid} ;
+
+    $shorts->{$lockid} = {} unless (exists($shorts->{$lockid}));
+    my $shortlist = $shorts->{$lockid} ;
+
+    # Check if we need to repopulate the list
+    unless ( @{$list} ) {
+        # Get timing
+        $timings->{$lockid} = [ 0, 0 ] unless (exists($timings->{$lockid}));
+        my $timing = $timings->{$lockid} ;
+
+        if ($timing->[0]) {
+            # Check how many time with passed to come back here: stop chrono
+            &TIMESTAT('SYNC-LIST-PROCESSED-'.$lockid);
+
+            # Update some statistics
+            my $delay = time - $timing->[0] ;
+            &MAXSTAT('SYNC-LIST-RATE-'.$lockid,
+                sprintf('%.2f',$timing->[1]/$delay)) if $delay;
+
+            $timing->[0] += $delay ; # Update to current time
+            $timing->[1]  = 0 ;      # Init list count
+
+        } else {
+            # Initialize processing timer
+            $timing->[0] = time ; # Set to current timer
+            $timing->[1] = 0 ;    # Init list count
+        }
+
+        &TIMESTAT('SYNC-LIST-REPOPULATE-'.$lockid);
+        &UPSTAT('SYNC-LIST-REPOPULATE-'.$lockid);
+
+        # Repopulate list
+        push @{$list}, grep { &is_tied_status($_) } keys(%TIED_STATUS) ;
+
+        $timing->[1] += @{$list} ;
+
+        &MAXSTAT('SYNC-LIST-COUNT-'.$lockid,$timing->[1]);
+        &MAXSTAT('SYNC-LIST-REPOPULATED-'.$lockid,scalar(@{$list}));
+        &TIMESTAT('SYNC-LIST-REPOPULATE-'.$lockid);
+        &TIMESTAT('SYNC-LIST-PROCESSED-'.$lockid); # Start the come back chono
+    }
+
+    # Get list count to return
+    my $return_count = $MAX_CONV_RATE > 0 ? $MAX_CONV_RATE : 20 ;
+
+    # Synchronize quickly the short/expected list
+    my @list = () ;
+    my @shortlist = keys(%{$shortlist}) ;
+    my $sync_shortlist = @shortlist < $return_count ?
+        scalar(@shortlist) : $return_count ;
+    if ($sync_shortlist) {
+        # Update @list with shortlist and remove shortlist entries
+        map { push @list, $_ ; delete $shortlist->{$_} }
+            splice @shortlist, 0, $sync_shortlist ;
+    }
+    &MAXSTAT('SYNC-LIST-SHORT-'.$lockid, $sync_shortlist);
+
+    # Synchronize slowly the complete list
+    my $sync_longlist = @list < $return_count ? $return_count - @list : 1 ;
+
+    # Update list with slow list elements
+    push @list, splice @{$list}, 0,
+        $sync_longlist > @{$list} ? scalar(@{$list}) : $sync_longlist
+        if @{$list} ;
+
+    &MAXSTAT('SYNC-LIST-LONG-'.$lockid, $sync_longlist);
+
+    &MAXSTAT('SYNC-LIST-'.$lockid,scalar(@list));
+
+    return @list ;
+}
+
+sub sync_list_inject_again {
+    # Empty the current synching list by re-injecting them in expected keys list
+    my $lockid = shift || $LOCKID ;
+    my $array  = shift || () ;
+    return unless @{$array} ;
+    &UPSTAT('SYNC-INJECT-AGAIN-'.$lockid);
+    &MAXSTAT('SYNC-INJECTED-AGAIN-'.$lockid,scalar(@{$array}));
+    map {
+        &Debug("Inject $_ in $lockid shortlist") if ($ADVANCED_DEBUGGING);
+        $sync_list[1]->{$lockid}->{$_} = 1
+    } splice @{$array} ;
+}
+
+sub in_expected_sync_list {
+    # Populate expected keys to be synched
+    my $lockid = shift ;
+    my $key    = shift ;
+
+    my $this = exists($sync_list[1]->{$lockid}) ?
+        $sync_list[1]->{$lockid} : $sync_list[1]->{$lockid} = {} ;
+    $this->{$key} = 1 ;
+
+    &Debug("Expecting synchronization on $key in $lockid shortlist")
+        if ($ADVANCED_DEBUGGING);
+    &UPSTAT('EXPECTED-SYNC-ADDED-'.$lockid);
+}
+
+sub sync_new_list {
+    # Check new status to be synched
+    my $lockid = shift || $LOCKID ;
+    my @new_status = () ;
+    my $shared_list = &SharedList( $lockid );
+    if (@{$shared_list}) {
+        map {
+            my $status = shift @{$shared_list} ;
+            push @new_status, $status ;
+            &Debug("Got '$status' from '$lockid' SharedList at #$_")
+                if ($ADVANCED_DEBUGGING);
+            } 0..$#{$shared_list} ;
+    }
+    &FreeSharedList( $lockid );
+    return () unless @new_status ; # Avoid statistics if nothing new found
+    &UPSTAT('SYNC-NEW-LIST-'.$lockid);
+    &MAXSTAT('SYNC-NEW-LIST-COUNT-'.$lockid,scalar(@new_status));
+    return @new_status ;
+}
+
+sub tie_status_hash {
+    my $lockid = shift || $LOCKID ;
+    $CURRENTMODE = shift ;
+    $CURRENTMODE = 1 unless (defined($CURRENTMODE));
+
+    my $file = &dbm_base . $lockid ;
+
+    # Synchronize mode with lock status, we can only write if we have an
+    # exclusive lock on the file
+    $CURRENTMODE = $CURRENTMODE ? &dbm_lock( $file, $lockid ) : 0 ;
+
+    if (tied(%TIED_STATUS)) {
+        &UPSTAT('WARNING-UNEXPECTED-'.$lockid.'-UNTIE-NEEDED');
+        &StatusDebug("Can't tie again hash, trying to untie first");
+        untie %TIED_STATUS ;
+    }
+
+    # Tie STATUS hash with read/write access
+    my $ret = tie( %TIED_STATUS , 'GDBM_File' , $file ,
+        ($CURRENTMODE ? GDBM_WRCREAT|GDBM_NOLOCK : GDBM_READER) , oct(660) );
+
+    # Inform A2P::Status API it can write in tiehash
+    if (defined($ret) and $ret == tied(%TIED_STATUS)) {
+        $STATUS{__GDBM_WRITER__} = $CURRENTMODE ;
+    } else {
+        delete $STATUS{__GDBM_WRITER__} ;
+    }
+
+    return $ret ;
+}
+
+my $shrink_timer = {} ; # Timers to reorganize gdbms
+sub _shrink_gdbm_file {
+    my $lockid = shift ;
+
+    # Can only shrink GDBM files at least each minute
+    return 0 if ( exists($shrink_timer->{$lockid})
+        and &tv_interval($shrink_timer->{$lockid}) < 60 );
+
+    # Get file statistics
+    my $stat = stat( &dbm_base . $lockid ) or return 0 ;
+
+    # Check if we can shrink GDBM file each minute if file is greater than 1Mb
+    my $delay = $stat->size > 1024000 ? 60 : 600 ; # default is 10 minutes
+    return if ( exists($shrink_timer->{$lockid})
+        and &tv_interval($shrink_timer->{$lockid}) < $delay );
+
+    my $stat_tag = 'REORGANIZE-GDBM-'.$lockid ;
+    &UPSTAT($stat_tag.'-CHECK');
+
+    # Get file time update and apply factor relative to file size
+    my $condition = ( time - $stat->mtime ) * int( $stat->size / 512000 ) ;
+
+    # Condition is equivalent to a GDBM file not used since at least 40 seconds
+    # if the file size is about 0,5-1 Mb. Lower size won't be shrinked. Greater
+    # will be shrink in a less time interval. On a high load, the shrink will
+    # be delayed until activity is reduced on a minimum basis: at least 1 second
+    # of inactivity and file size is greater than 20 Mbytes
+    if ( $condition > 40 ) {
+        $! = 0 ;
+        &UPSTAT($stat_tag.'-TRY');
+        &MAXSTAT($stat_tag.'-FILE-SIZE',$stat->size);
+        my $shrinked = 0 ;
+        my $gdbm = tied(%TIED_STATUS) ;
+        if (ref($gdbm) =~ /^GDBM_File/i ) {
+            &TIMESTAT($stat_tag);
+            $shrinked = $gdbm->reorganize() ;
+            &TIMESTAT($stat_tag);
+        }
+        &Info("Bad shrink on $lockid GDBM jobsstatus file: $!")
+            unless (defined($shrinked) and $shrinked > -1 and ! $!);
+        $shrink_timer->{$lockid} = [ &gettimeofday() ] ;
+
+    } else {
+        &UPSTAT($stat_tag.'-SKIPPED');
+    }
+}
+
+my %StatusDebug = (
+    1 => "Cleaning jobstatus objects tied in hash",
+    2 => "Get status object",
+    3 => "Cleaning jobstatus objects cache",
+    4 => "Updating object status",
+    5 => "Updating object infos",
+    6 => "Saving objects status to tied hash",
+    7 => "Status update done"
+    );
+
+my %MESG = () ;
+sub StatusDebug {
+    # Specific debugging handling to keep good performance when not activated
+    return unless ($ADVANCED_DEBUGGING);
+    my $add = "" ;
+    if (defined($MESG{$_[0]}) and my ( $repeat, $timer ) = @{$MESG{$_[0]}}) {
+        $MESG{$_[0]}->[0] ++ ;
+        return unless (&tv_interval($timer)>=60);
+        $add = " ($repeat times)" unless ($repeat==1);
+
+    } else {
+        $MESG{$_[0]} = [ 1 ] ;
+    }
+    $MESG{$_[0]}->[1] = [ &gettimeofday() ] ;
+    &Debug($_[0] =~ /^\d+$/ ? $StatusDebug{$_[0]}.$add : "@_$add");
+}
+
+my $RESYNCH_TIMEOUT = 10 ; # 10 seconds before synchronizing in tied hash
+sub sync_lockid {
+    # Sync the object for a lockid from tied to DB
+    # Return true if we need to recheck as writer
+    my $lockid = shift ;
+    my $mode   = shift ;
+
+    # Check initialization
+    $sync_list[3]->{$lockid} = {} unless (exists($sync_list[3]->{$lockid}));
+    my $resynch_list = $sync_list[3]->{$lockid} ;
+
+    my $status_count   = 0 ;
+    my $resynch_needed = 0 ;
+    my $timeout = &ms( -$RESYNCH_TIMEOUT );
+
+    my @keys ; # List of keys to handle
+
+    # Get a list of keys to check regarding the called mode
+    if ($mode) {
+        # As writer we should also synchronize with DB in the same time
+        my @resynch_keys = keys(%{$resynch_list}) ;
+        &MAXMINSTAT('SYNC-LOCKID-RESYNCH-KEYS-'.$lockid,scalar(@resynch_keys));
+        @keys = grep { $resynch_list->{$_} < $timeout } @resynch_keys ;
+
+    } else {
+        # Search for status to synchronize with DB
+        # Get also new status from shared list
+        @keys = ( &sync_new_list($lockid), &sync_list( $lockid ) ) ;
+    }
+
+    my @too_quick = () ;
+
+    # Set a counter to limit processing to not overload the service
+    # But we should process at least 10% of the list in case of big load
+    my $long_processing = 0 ;
+    my $max_long_processing = @keys > 256 ? @keys >> 4 : 16 ;
+
+    while ( @keys ) {
+        my $key = shift @keys ;
+
+        $status_count ++ ;
+
+        # Get the status object or continue
+        my $status = new A2P::Status( \%STATUS, \%TIED_STATUS, $key )
+            or next ;
+
+        # Skip if not a status
+        next unless (&is_status($status));
+
+        # Keep this status in cache for a while if we are searching for
+        if ( $search_status and ( $status->is_job eq $search_status
+        or $status->{JOBID} eq $search_status
+        or $status->{AFP} eq $search_status )) {
+            $status->cached ;
+            $search_status = '' ;
+        }
+
+        # Don't recheck status too quickly
+        &UPSTAT('SYNC-LOCKID-QUICK-CHECK-DB-SYNCH-'.$lockid);
+        if ( ! $mode and $status->checking_too_quickly() ) {
+            push @too_quick, $key if ($status->dirty_bit(3));
+            &UPSTAT('SYNC-LOCKID-TOO-QUICK-DB-SYNCH-'.$lockid);
+            next ;
+        }
+
+        # Remark: The dirty bit 3 should only be reset when every steps are
+        # finished to guaranty the status is in DB
+
+        # Synchronize status with DB
+        if ($status->sync_with_db) {
+            &UPSTAT('SYNC-LOCKID-DB-SYNCHED-'.$lockid);
+            if ($status->is_finished) {
+                &UPSTAT('SYNC-LOCKID-FINISHED-'.$lockid.'-'.$mode);
+                if ($mode) {
+                    &Debug("Synchro $lockid to DB for $key completed")
+                        if ($ADVANCED_DEBUGGING);
+                    &UPSTAT('SYNC-LOCKID-DB-SYNCH-COMPLETED-'.$lockid);
+
+                    # Will save to tied so reset dirty bit 3 just before
+                    $status->unset_dirty_bit(3);
+
+                # Avoid check completed status
+                } elsif ($status->dirty_bit(3)) {
+                    # A resynch is needed if tied timer has reached a time out
+                    # This can be seen as an activity delay on this status
+                    my $resynch = $timeout - $status->is_tied_timer ;
+                    &MAXMINSTAT('SYNC-LOCKID-FINISHED-TIMER-'.$lockid,$resynch);
+                    if ( $resynch > 0 ) {
+                        $resynch_needed ++ ;
+                        $resynch_list->{$key} = $status->is_tied_timer ;
+                    }
+                }
+
+            } else {
+                &Debug("Synchro $lockid to DB for $key done at rev" .
+                    $status->db_revision)
+                    if ($ADVANCED_DEBUGGING);
+
+                # Still set it to resynchronize but don't force it now
+                $resynch_list->{$key} = $status->is_tied_timer ;
+            }
+
+        } else {
+            &UPSTAT('SYNC-LOCKID-BAD-DB-SYNCH-'.$lockid);
+            &Debug("Bad synchronization of $lockid $key status to DB");
+        }
+
+        # We should check again this status until finished
+        &in_expected_sync_list( $lockid, $key ) if ($status->dirty_bit(3));
+
+        # Be sure to only save when job is really finished
+        if ($mode and $status->is_finished) {
+            # We can update DBM with current SID
+            &Debug("Updating $key in $lockid tied hash with sid " .
+                $status->get_sid_key)
+                if ($ADVANCED_DEBUGGING);
+
+            unless ($status->save_tied('not a revision')) {
+                &Debug("Can't update tied status $key in $lockid mem hash: $!");
+                # We shouldn't continue to update now, but keep in mind what we
+                # have to do, so release the ressource very quickly
+                &UPSTAT('SYNC-LOCKID-DELAY-DBM-SYNCH-'.$lockid);
+                last ;
+            }
+
+            # Update recheck hash
+            delete $resynch_list->{$key};
+
+            # Don't keep tied hash too much time so don't write too much status
+            last if ( $status_count > 4 );
+
+        } else {
+            # Also control timing when not gdbm writer
+            #
+            last if ( &_micro_timing(1)
+                and $long_processing++ > $max_long_processing );
+        }
+    }
+
+    # Inject pending keys
+    &sync_list_inject_again( $lockid, \@keys ) if @keys ;
+    &sync_list_inject_again( $lockid, \@too_quick ) if @too_quick ;
+
+    &MAXSTAT('SYNC-LOCKID-COUNTED-STATUS',$status_count);
+    &MAXSTAT('SYNC-LOCKID-RESYNCH-NEEDED',$resynch_needed);
+
+    return $resynch_needed ;
+}
+
+sub sync_dbm_to_db {
+    # This API checks any available jobstatus DBM file and returns a reference
+    # to a hash agregation of any Status object found
+    &TIMESTAT('SYNC-DBM-TO-DB'); &UPSTAT('SYNC-DBM-TO-DB');
+
+    my %DBMS    = () ;
+    my %recheck = () ;
+
+    # Get the list of available DBM file with the current base
+    # The list is a hash which LOCKIDs as keys
+    my $base = &dbm_base ;
+    my $base_re = qr/^$base(.+)$/ ;
+    %DBMS =  map { $_ =~ $base_re ; $1 => 1 }
+        grep { ! -d $_ } grep { ! /\.LCK$/ } glob( $base . '*' ) ;
+
+    # Initialize timing check to not overload the computer
+    &_micro_timing( 0, $USLEEP >> 1 ); # MAXTIME = USLEEP / 2
+
+    my $sync_count = scalar(keys(%DBMS));
+    my $retries    = -1 ;
+
+    # 2. Read each files and updates our agregation hash
+    while (( $sync_count or keys(%recheck)) and $retries++ < 10 ) {
+        my @lockids = grep { $DBMS{$_} } keys(%DBMS) ;
+        push @lockids, keys(%recheck) unless ( @lockids and $retries < 10 );
+
+        # Leave loop when nothing's to do
+        last unless (@lockids);
+
+        foreach my $lockid ( @lockids ) {
+            &UPSTAT('SYNC-DBM-LOCKID-'.$lockid);
+
+            # Check to reopen gdbm as writer
+            my $db_mode = 0 ;
+            if (exists($recheck{$lockid})) {
+                &UPSTAT('SYNC-DBM-AS-WRITER-'.$lockid);
+                $db_mode = 1 ;
+                delete $recheck{$lockid} ;
+            }
+
+            # Get the lock on tie file updating %TIED_STATUS reference
+            my $is_tied = &tie_status_hash($lockid, $db_mode) ;
+
+            # Check we got expected mode
+            unless ( $db_mode == $CURRENTMODE ) {
+                &UPSTAT('SYNC-DBM-LOCKID-'.$lockid.'-ERROR-MODE-'.$db_mode);
+                next ;
+            }
+
+            # Really re-sync if tied
+            if (defined($is_tied)) {
+                &TIMESTAT('SYNC-DBM-LOCKID-'.$lockid.'-'.$db_mode);
+
+                $DBMS{$lockid} = 0 ;
+                $sync_count -- ;
+
+                $recheck{$lockid} = 1
+                    if (&sync_lockid( $lockid, $db_mode ));
+
+                # Untie the hash after check to clean it
+                undef $is_tied ;
+                untie %TIED_STATUS ;
+
+                &TIMESTAT('SYNC-DBM-LOCKID-'.$lockid.'-'.$db_mode);
+
+                # Try to clean some entries in tied hash
+                &_tiehash_cleaner($lockid) ;
+            }
+
+            # Anyway unlock the dbm file
+            &dbm_unlock($lockid);
+        }
+
+        # Sleep a little if we couldn't be able to read a GDBM as other process
+        # can access it, unless resynch is needed
+        if ( $sync_count > 0 ) {
+            &Debug("Sleeping as some status has not been kept");
+            &UPSTAT('SYNC-DBM-BAD-SYNC-COUNT');
+            usleep $USLEEP ;
+        }
+    }
+
+    # Compute few service statistics
+    &MAXSTAT('SYNC-DBM-RETRY-SYNC',$retries) if ($retries);
+    &TIMESTAT('SYNC-DBM-TO-DB');
+
+    # Then clean our cache
+    &cache_cleaner();
+
+    return $sync_count ;
+}
+
+my @micro_timer = ( 0, 0, 0 ) ;
+sub _micro_timing {
+    my $flag = shift ;
+    my @time = &gettimeofday() ; # Get current timer
+    my $time = int( $time[0] * 1000000 + $time[1] ) ;
+    # First call with zero flag make timer initialization
+    if ($flag) {
+        my $delta = $time - $micro_timer[0] ;
+        # Exit if timer is not reached
+        return 1 unless ( $delta > $micro_timer[2]);
+        &MAXSTAT($LOCKID.'-MICRO-TIMING-ON-DELTA',$delta);
+        &UPSTAT($LOCKID.'-USLEEP-'.$micro_timer[2].'-IN-MICRO-TIMING');
+        return usleep 1000 && 0 unless ( $time < $micro_timer[1] );
+        usleep $micro_timer[2] ;
+
+    } else {
+        # USLEEP * 4 should not be reached, set this as timeout
+        $micro_timer[1] = $time + $USLEEP << 2 ;
+        # Second argument is then the maxtime to sleep in later calls
+        $micro_timer[2] = shift || $USLEEP ;
+    }
+    return $micro_timer[0] = $time ; # Update timer
+}
+
+sub getstatus_from_db {
+    # This API get each jobstatus found in DB
+    # It populates the local cache hash and returns a reference to this hash
+    # Used from service-lib.pl in afp2print Webmin module
+
+    # Some filters can be passed
+    my $lockid_filter = shift || "" ;
+    # Next are references
+    my $jname_filter  = shift || "" ; # Can be a ref regex
+    my $day_filter    = shift || "" ;
+    my $status_filter = shift || "" ; # Can be a ref regex
+    my $sql           = shift || "" ; # Can be a hash ref
+
+    unless (@_==3) {
+        return &Error("DBI configuration not provided with: '@_'");
+    }
+    # Update DBI access configuration
+    $DBI_DSN    = shift ;
+    $DBI_USER   = shift ;
+    $DBI_PASSWD = shift ;
+
+    # Can be better called with a call-back
+    my $filter = ref($lockid_filter) =~ /^CODE$/ ? $lockid_filter : sub { 0 };
+    $lockid_filter = "" if (&$filter);
+
+    my %filtered = () ;
+    my @filter = $filter ? () : (\$jname_filter,\$day_filter,\$status_filter);
+
+    my $status = new A2P::Status( \%STATUS, \%TIED_STATUS ) ;
+
+    # Remove this first from cache as it is just an API accessor
+    $status->remove_from_cache ;
+
+    while (defined($status) and $status and $status->get_next_from_db($sql)) {
+        next unless $status->is_job ;
+        # Insert a copy in the cache for our JOB name
+        $STATUS{$status->is_job} = $status->clone
+            unless ((@filter and $status->is_filtered(@filter))
+            or (&$filter and &$filter($status)));
+    }
+
+    # Don't keep this entry as not a status
+    delete $STATUS{__SID__} ;
+
+    return \%STATUS ;
+}
+
+sub is_status {
+    return 0 unless @_ ;
+
+    # Check if argument is an A2P::Status object
+    return ref($_[0]) =~ /^A2P::Status$/ ? 1 : 0 ;
+}
+
+sub is_tied_status {
+    return 0 unless @_ ;
+    &TIMESTAT('IS-TIED-STATUS?');
+
+    # Check if key/value designed by
+    my $key = shift ;
+
+    my $is_status = 0 ;
+
+    if ( $key =~ /_rev$/ or exists($TIED_STATUS{$TIED_STATUS{$key}})
+    or ( $TIED_STATUS{$key} =~ /^\d+$/
+    and exists($TIED_STATUS{'_SID_'.$TIED_STATUS{$key}}) ) ) {
+        # Return false if key is a rev key
+        # Check also if its a reference to another key and then return false
+        &UPSTAT('IS-TIED-STATUS-NO');
+
+    } elsif ( $key =~ /^_SID_\d+$/
+    or $TIED_STATUS{$key} =~ _freezed_status_re ) {
+        $is_status = 1 ;
+        &UPSTAT('IS-TIED-STATUS-YES');
+
+    } else {
+        &UPSTAT('IS-TIED-STATUS-NO-2');
+    }
+
+    return $is_status ;
+}
+
+# Private hash to help clean tiehashs from a2p-status
+my %th_cleaner = ( TIMER => {}, LIST => {} ) ;
+my %lost = () ;
+sub _tiehash_cleaner {
+    # Still return if MAXAGE is not set (dangerous)
+    return 0 unless ( $STATUS_MAXAGE ) ;
+
+    my $lockid = shift ;
+
+    # Get the current processed list
+    my $list = exists($th_cleaner{LIST}->{$lockid}) ?
+        $th_cleaner{LIST}->{$lockid} : [] ;
+
+    # Return if list is empty and timer list is lower than 5 minutes, but do a
+    # clean on the first call
+    return 0 if ( ! @{$list} and exists($th_cleaner{TIMER}->{$lockid})
+        and &tv_interval($th_cleaner{TIMER}->{$lockid}) < 300 );
+
+    &UPSTAT('TH-CLEANER-API-'.$lockid);
+
+    unless (@{$list}) {
+        # Try to access tiehash as reader when preparing the list
+        return 0 unless (defined(&tie_status_hash($lockid, 0))) ;
+
+        &TIMESTAT('TH-CLEANER-INIT-'.$lockid);
+        &UPSTAT('TH-CLEANER-INIT-API-'.$lockid);
+
+        # Update timer now
+        $th_cleaner{TIMER}->{$lockid} = [ &gettimeofday() ];
+
+        # Initialize hash keys list, being sure to only have status keys
+        $list = [ grep { &is_tied_status($_) } keys(%TIED_STATUS) ] ;
+        $th_cleaner{LIST}->{$lockid} = $list ;
+
+        &StatusDebug(1);
+
+        # This value indicates which $MAX_CACHED_STATUS we should set as conf
+        &MAXSTAT('TH-CLEANER-INIT-COUNT-'.$lockid,scalar(@{$list}));
+        &TIMESTAT('TH-CLEANER-INIT-'.$lockid);
+
+        untie %TIED_STATUS ;
+
+        # Still return anyway
+        return 0 ;
+    }
+
+    &TIMESTAT('TH-CLEANER-'.$lockid);
+
+    # Try to access tiehash as writer
+    &tie_status_hash($lockid, 1) ;
+
+    # Short cut the processing loop in case we are not writer
+    my $maxcount = &cansavetied() ? 10 : 0 ;
+
+    # Only process a limited count of jobs by call
+    my $count = 0 ;
+    while ( @{$list} and $count ++ < $maxcount ) {
+        my $job = shift @{$list} ;
+
+        # Skip still removed entry
+        next unless (exists($TIED_STATUS{$job}));
+
+        # Reget this status from/into the cache
+        my $status = new A2P::Status( \%STATUS, \%TIED_STATUS , $job )
+            or next ;
+
+        # Check the age
+        &MAXSTAT('TH-CLEANER-STATUS-REAL-AGE-'.$lockid,$status->real_age);
+        if ( $status->is_done_and_timer_aged ) {
+            &StatusDebug("Cleaning $job in tied hash");
+            $status->remove_from_cache ;
+            $status->remove_from_tied_hash ;
+            &UPSTAT('TH-CLEANER-STATUS-CLEANED-'.$lockid);
+        }
+    }
+
+    &TIMESTAT('TH-CLEANER-'.$lockid);
+
+    # Check also to shrink GDBM some time
+    &_shrink_gdbm_file($lockid) if $maxcount ;
+
+    # Untie before leaving
+    untie %TIED_STATUS ;
+
+    1 ;
+}
+
+my $cache_timer     = undef ; # Timer to handle cache check
+my @cache_checklist = () ;
+my @cache_ages      = () ;
+my %age_checklist   = () ;
+my $cache_older     = 0 ;
+sub cache_cleaner {
+    # Clean cache object each minute (objects will be reloaded from
+    # tied file if deleted from cache)
+    return 0 if ( ! $STATUS_CACHE_MAXAGE
+        or ( ! @_ and defined($cache_timer) and &tv_interval($cache_timer)< 60 )
+        # Also return it known max cache age
+        or ( $cache_older and 1000*time-$cache_older<$STATUS_CACHE_MAXAGE ));
+
+    # Remove still unused keys if test case only
+    map { delete $STATUS{$_} } grep { /^__/ } keys(%STATUS) if @_ ;
+
+    &UPSTAT('STATUS-OBJECT-CACHE-CLEANER-API');
+
+    # Arguments should only used for testing purpose
+    my $max_loops = shift || 10 ;
+
+    unless (@cache_checklist) {
+        &TIMESTAT('CACHE-CLEANER-INIT');
+        my @keys = keys(%STATUS) ;
+        &MAXSTAT('CACHE-KEYS-COUNT',scalar(@keys));
+
+        # Be sure to only have status keys, and filter duplicate references
+        @cache_checklist = () ;
+        foreach my $job ( grep { &is_status($STATUS{$_}) } @keys ) {
+            push @cache_checklist, $job
+                unless (grep { $STATUS{$job} == $STATUS{$_} } @cache_checklist);
+        }
+
+        # Prepare a list of ages based on timers if still not done
+        unless (keys(%age_checklist)) {
+            %age_checklist = () ;
+            map { push @{$age_checklist{$STATUS{$_}->timer}}, $_ }
+                @cache_checklist ;
+
+            # List the ages
+            @cache_ages = sort(keys(%age_checklist)) ; # First is older
+        }
+
+        # Set now the timer
+        $cache_timer = [ &gettimeofday() ] ;
+        &StatusDebug(3);
+        &TIMESTAT('CACHE-CLEANER-INIT');
+
+        # Return anyway
+        return scalar(@cache_checklist) ;
+    }
+
+    my $status_count = @cache_checklist ;
+    &MAXSTAT('STATUS-OBJECT-KEPT-IN-CACHE',$status_count);
+
+    if ( $status_count > $MAX_CACHED_STATUS ) {
+        # Manage cache size
+        &UPSTAT('STATUS-OBJECT-MAX-CACHED-REACHED');
+        &TIMESTAT('CACHE-CLEANER-MAX-REACHED');
+
+        $cache_older = shift @cache_ages ;
+
+        my $limit = abs($MAX_CACHED_STATUS - 10) + 1 ; # Paranoid temp limit
+        while ( defined($cache_older) and $cache_older
+        and $status_count >= $limit ) {
+            my $aged = shift @{$age_checklist{$cache_older}} ;
+            if (defined($aged) and $aged and exists($STATUS{$aged})) {
+                &UPSTAT('CACHED-STATUS-OBJECT-EARLY-CLEANED');
+                $status_count -- ;
+                $STATUS{$aged}->remove_from_cache ;
+            }
+
+            unless (@{$age_checklist{$cache_older}}) {
+                # Don't forget to forget that age
+                delete $age_checklist{$cache_older} ;
+                $cache_older = shift @cache_ages ;
+            }
+        }
+
+        # Filter on existing keys
+        @cache_checklist = grep { exists($STATUS{$_}) } @cache_checklist ;
+
+        &TIMESTAT('CACHE-CLEANER-MAX-REACHED');
+        # Return anyway
+        return $status_count ;
+    }
+
+    &TIMESTAT('CACHE-CLEANER');
+
+    my $count = 0 ;
+    # Don't check too much cached values at a time
+    while ( @cache_checklist and $count ++ < $max_loops ) {
+        my $job = shift @cache_checklist ;
+        # Avoid cleaning not job or lost keys
+        next unless (exists($STATUS{$job}) and &is_status($STATUS{$job}));
+        if ( defined($STATUS{$job}->check_cached_aged) ) {
+            &UPSTAT('CACHED-STATUS-OBJECT-KEPT');
+        } else {
+            &UPSTAT('CACHED-STATUS-OBJECT-CLEANED');
+        }
+    }
+
+    &MAXSTAT('CACHED-STATUS-OBJECT-CHECKED',$count);
+    &TIMESTAT('CACHE-CLEANER');
+    return $count ; # Only used in tests
+}
+
+my @pending = () ;
+sub tied_update_status {
+    # Can be called without argument to compute any pending status
+    return unless (@_ or @pending);
+
+    my $Job    = shift ;
+    my $Step   = shift ;
+    my $Status = shift ;
+    my $Infos  = shift || {} ;
+
+    push @pending , [ $Job, $Step, $Status, $Infos ]
+        if (defined($Job));
+
+    # 1. We need to tie our hash to GDBM file before continuing
+    my $retries = 0 ;
+    my $timeout = [ &gettimeofday() ] ;
+    $! = 0 ;
+    while (!(defined(&tie_status_hash($LOCKID)) and &cansavetied)) {
+        ($! == 11)? &UPSTAT('BUSY-TIED-HASH'):&Warn("Can't lock GDBM file: $!");
+        $! = 0 ;
+        &dbm_unlock();
+        tied(%TIED_STATUS) and untie %TIED_STATUS ;
+        &Warn("Can't unlock GDBM file: $!") if $! ;
+        ++ $retries and &MAXSTAT('FORCED-UPDATE-STATUS-RETRY',$retries);
+        if ( &tv_interval($timeout) > 60 ) {
+            &UPSTAT('HASH-NOT-TIED-AFTER-60s');
+            last ;
+        }
+        usleep ( $retries < 5 ? $USLEEP >> 1 :
+            ($retries < 10 ? $retries * $USLEEP : 10 * $USLEEP ));
+        $! = 0 ;
+    }
+
+    while (@pending) {
+        my $ref = shift @pending ;
+        ( $Job, $Step, $Status, $Infos ) = @{$ref} ;
+
+        # Strip any number at the end of job name
+        $Job =~ s/-\d+$// ;
+
+        # 2. Get the status object
+        my $jobstatus = new A2P::Status( \%STATUS, \%TIED_STATUS , $Job ) ;
+
+        unless (defined($jobstatus) and $jobstatus) {
+            &Warn("Can't update Job status of $Job");
+            unshift @pending, $ref ;
+            last ;
+        }
+
+        # 3. Updating object status
+        &StatusDebug(4);
+        &Warn("$Job status at step $Step to $Status not updated")
+            unless ( $jobstatus->step_status($Step,$Status) );
+
+        # 4. Update object with infos
+        &StatusDebug(5);
+        $jobstatus->infos($Infos);
+
+        # 5. Update object timer to reset its cache age
+        $jobstatus->cached ;
+
+        # 6. Saving tied objects
+        &StatusDebug(6);
+        $jobstatus->save_tied ;
+    }
+
+    # 7. Then we can untie our hash if really tied
+    &StatusDebug(7);
+    untie %TIED_STATUS ;
+
+    # 8. Also unlock DBM file if locked
+    &dbm_unlock();
+
+    # Keep internal stats
+    if (@pending) {
+        &DebugPendingQueue();
+        $STATS{'PENDING-JOBSTATUS'} = join(';',map { "@{$_}" } @pending) ;
+
+    } elsif (exists($STATS{'PENDING-JOBSTATUS'})) {
+        &MAXSTAT('PENDING-JOBSTATUS-COUNT',scalar(@pending));
+        delete $STATS{'PENDING-JOBSTATUS'} ;
+    }
+
+    return \%TIED_STATUS ;
+}
+
+my $debug_pending_timer ;
+sub DebugPendingQueue {
+    return unless ($ADVANCED_DEBUGGING);
+
+    # Handle timer, debug only at max each second
+    return unless (defined($debug_pending_timer)
+        and &tv_interval($debug_pending_timer) > 1);
+    $debug_pending_timer = [ &gettimeofday() ] ;
+
+    my %pendings = () ;
+
+    # Analyse list
+    map {
+        my ( $n, $s, $S, $I ) = @{$_} ;
+        $pendings{$n} = { STEPMIN => 12 , STEPMAX => 0 , STATUS => '' }
+            unless (exists($pendings{$n}));
+        $pendings{$n}->{STEPMIN} = $s if ( $s < $pendings{$n}->{STEPMIN});
+        $pendings{$n}->{STEPMAX} = $s if ( $s > $pendings{$n}->{STEPMAX});
+        $pendings{$n}->{STEP} = $s, $pendings{$n}->{STATUS} = $S
+            if ( $S eq 'A' or ( $pendings{$n}->{STATUS} ne 'A'
+            and $pendings{$n}->{STATUS} ne 'o' ));
+    } @pending ;
+
+    my @pendings = keys(%pendings) ;
+    &StatusDebug(@pendings." pending status updates");
+
+    my @abterms = grep { $pendings{$_}->{STATUS} eq 'A' } @pendings ;
+    if (@abterms) {
+        &StatusDebug(@abterms." pending ABTERM status update (@abterms)");
+        map { &StatusDebug("$_ ABTERM: status steps: ".$pendings{$_}->{STEPMIN}.
+            " - ".$pendings{$_}->{STEPMAX}.(exists($pendings{$_}->{STEP})?
+            " ; ABTERM Step: ".$pendings{$_}->{STEP} : ""));
+            delete $pendings{$_} ;
+        } @abterms ;
+    }
+
+    # Get again list after ABTERM keys deletion
+    @pendings = keys(%pendings) ;
+    if (@pendings) {
+        &StatusDebug(@pendings." pending ok status update:");
+        map { &StatusDebug("$_: status steps: ".$pendings{$_}->{STEPMIN}.
+            " - ".$pendings{$_}->{STEPMAX});
+        } @abterms ;
+    }
+}
+
+END {
+    # Try to purge pending status updates
+    &tied_update_status ;
+
+    if ($ADVANCED_DEBUGGING) {
+        foreach my $mesg (keys(%MESG)) {
+            next unless ( $MESG{$mesg}->[0] > 1 );
+            $MESG{$mesg}->[0] -- ;
+            $MESG{$mesg}->[1] = [ 0, 0 ];
+            &StatusDebug($mesg);
+        }
+    }
+
+    # Save in_expected sync lists in SharedList lists
+    foreach my $lockid (keys(%{$sync_list[1]})) {
+        my @expected = keys(%{$sync_list[1]->{$lockid}});
+        my $shared = &SharedList( $lockid, 'forced' );
+        push @{$shared}, @expected if ( ref($shared) =~ /^ARRAY/i );
+        &FreeSharedList( $lockid );
+    }
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
Index: /A2P/a2p/A2P/Listener.pm
===================================================================
--- /A2P/a2p/A2P/Listener.pm	(revision 3)
+++ /A2P/a2p/A2P/Listener.pm	(revision 3)
@@ -0,0 +1,574 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+package A2P::Listener;
+
+# Derived class from Thread.pm
+use base qw(A2P::Thread Exporter);
+
+use strict ;
+use Socket ;
+use IO::Socket ;
+use Time::HiRes qw(ualarm gettimeofday tv_interval) ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use A2P::Com   qw( IsCom GetCom comSAY comREQ comCOM comDONE comASK comJOB );
+use A2P::Tools qw( ShortID );
+use A2P::XML ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 450 $ =~ /(\d[0-9.]+)\s+/ ;
+}
+our $VERSION ;
+
+my %conn    = () ;
+my %XML     = () ;
+my %timeout = () ;
+my $clientrequest = 0 ;
+my @AUTHORIZED = ( INADDR_LOOPBACK ) ;
+my $ANY_OK  = 0 ;
+my $jobcount = 0 ;
+
+my @timer = &gettimeofday() ;
+
+################################################################################
+##             Listener handling code                                         ##
+################################################################################
+sub Do {
+    my $self = shift ;
+    my $ref  = shift ;
+
+    my $Ret = 1 ;
+
+    my ( @Req , @Ask );
+
+    # Handle response from service to currently connected client as comSAY
+    if ( @Req = &IsCom( comSAY , $$ref )) {
+
+        # Cache the following test as re-used when true
+        my $donetest = ( @Req > 1 ) ? &IsCom( comDONE , $Req[1] ) : 0 ;
+
+        # Anyway count down job done
+        $donetest and --$jobcount ;
+
+        if (defined($XML{$Req[0]}) and defined($conn{$Req[0]})) {
+            # Handle XML request
+            $self->XMLEvent(@Req);
+
+        } elsif (defined($conn{$Req[0]})) {
+            # Handle direct external request
+            &Debug("Con $Req[0]: Sending answer: $Req[1]");
+            $clientrequest = $Req[0] ;
+            $self->Answer( $Req[1] );
+
+            # Reset the time out for this connection
+            $timeout{$Req[0]} = [ &gettimeofday() ] ;
+
+        } else {
+            &Warn("Connection $1 not available, can't send answer: $2");
+            delete $XML{$Req[0]} if (defined($XML{$Req[0]}));
+            delete $conn{$Req[0]} ;
+            # Still return to not close non available connection
+            return --$Ret ;
+        }
+
+        # Then close connection if required
+        if ( $donetest and $CLOSE_CONNECTIONS) {
+            &Info("Con $Req[0]: Closing connection with client");
+            $self->CloseClient( $Req[0] );
+        }
+
+    # Handle client connection as comREQ
+    } elsif ( $clientrequest and @Ask = &IsCom( comASK , $$ref )) {
+
+        if ( $jobcount < $MAXJOBS ) {
+            my $Con = $clientrequest ;
+
+            # Necessary for &Answer to know message is for parent
+            $clientrequest = 0 ;
+
+            &Debug("Con $Con: request to $Ask[0] is '$Ask[1]'");
+            $self->Answer( $Ask[0] , &GetCom( comASK , $Con => $Ask[1] ));
+
+            $jobcount ++ ;
+
+        } else {
+            &Warn("Closing $clientrequest as max jobs count has been reached");
+            $self->Answer( "ERROR: MAX JOBS COUNT REACHED" );
+            $self->CloseClient($clientrequest);
+        }
+
+    # Handle status exchange with parent
+    } elsif ( $$ref =~ m|^STARTED$|i ) {
+        &Debug("I can say service is started");
+        $self->{STARTED} ++ ;
+        $self->Answer($$ref);
+
+    } elsif ( $$ref =~ m|^STATUS$|i ) {
+        $self->Answer($self->{STARTED});
+        &Debug("Returned status '$self->{STARTED}'");
+
+    } else {
+        $self->ThisError("Got bad request '$$ref' for listener");
+        $Ret -- ;
+    }
+
+    return $Ret ;
+}
+
+sub DoBeforeQuit {
+    my $self = shift ;
+
+    $clientrequest = 0 ;
+
+    # Close any client connection
+    map {
+        $clientrequest = $_ ;
+        $self->Answer( "Service is stopping" );
+        $self->CloseClient( $_ )
+    } keys(%conn) ;
+
+    close($self->{SERVER});
+
+    unlink($LISTENER);
+
+}
+
+sub ThreadInit {
+    my $self    = shift ;
+
+    $SIG{'IO'}   = sub { &UPSTAT('GOT-SIGNAL-IO'); } ;
+    $SIG{'PIPE'} = sub { &UPSTAT('GOT-SIGNAL-PIPE'); } ;
+
+    # Open UNIX Socket
+    my $sockaddr = pack_sockaddr_un( $LISTENER );
+
+    socket( $self->{SERVER} , PF_UNIX,SOCK_STREAM , 0 )
+        or return $self->Error("Listener can't create a socket: $!");
+
+    bless $self->{SERVER} , "IO::Socket" ;
+
+    unlink($LISTENER);
+
+    bind ( $self->{SERVER} , $sockaddr )
+        or return $self->Error("Listener can't bind server socket: $!");
+
+    listen( $self->{SERVER} , SOMAXCONN )
+        or return $self->Error("Listener can't listen server: $!");
+
+    # Handle a list of available servers, only UNIX socket server by default
+    $self->{SERVERS} = [ $self->{SERVER} ];
+
+    # Open TCP/IP Socket
+    if ($USE_TCPIP_SOCKET) {
+        # Checking port
+        &Warn("Unsupported port '$USE_TCPIP_PORT' for TCP/IP listening," .
+            " resetting port to default " . ( $USE_TCPIP_PORT = 6400 ) )
+            unless ( $USE_TCPIP_PORT > 0 and $USE_TCPIP_PORT < 65000 );
+
+        my $proto = getprotobyname('tcp');
+        socket( $self->{TCPSERVER}, PF_INET, SOCK_STREAM, $proto )
+            or return $self->Error("Listener can't create a TCP/IP socket: $!");
+
+        bless $self->{TCPSERVER} , "IO::Socket" ;
+
+        setsockopt( $self->{TCPSERVER}, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
+            or return $self->Error("Can't set TCP/IP REUSEADDR options: $!");
+
+        setsockopt( $self->{TCPSERVER}, SOL_SOCKET, SO_KEEPALIVE, pack("l", 1))
+            or return $self->Error("Can't set TCP/IP KEEPALIVE options: $!");
+
+        if ($USE_ONLY_LOOPBACK) {
+            $sockaddr = sockaddr_in( $USE_TCPIP_PORT , INADDR_LOOPBACK );
+
+        } else {
+            $sockaddr = sockaddr_in( $USE_TCPIP_PORT , INADDR_ANY );
+        }
+        bind( $self->{TCPSERVER}, $sockaddr )
+            or return $self->Error("Can't bind server on TCP/IP socket: $!");
+
+        listen( $self->{TCPSERVER} , SOMAXCONN )
+            or return $self->Error("Can't listen as TCP/IP server: $!");
+
+        # Add TCP/IP server to servers list
+        push @{$self->{SERVERS}}, $self->{TCPSERVER} ;
+
+        @AUTHORIZED = ( INADDR_LOOPBACK ) ;
+        foreach my $host (split(/\s+/,$AUTHORIZED_HOST)) {
+            if ( $host =~ /^any$/i or $host eq '0.0.0.0' ) {
+                $ANY_OK ++ ;
+                next ;
+            }
+            my $packed = inet_aton($host) ;
+            if (defined($packed)) {
+                push @AUTHORIZED , $host ;
+                &Debug("IP ".inet_ntoa($packed)." is authorized to access a2p");
+
+            } else {
+                &Warn("Skipping $host as its ip wasn't resolved");
+            }
+        }
+    }
+
+    %conn    = () ;
+    %timeout = () ;
+    $clientrequest = 0 ;
+}
+
+sub CloseClient {
+    my $self = shift ;
+    my $Conn = shift ;
+    my $Err  = shift || 0 ;
+    my $Mesg = shift || "" ;
+
+    $self->ThisError($Mesg), $self->Answer($Mesg) if $Err ;
+
+    my $socket = defined($conn{$Conn}) ? $conn{$Conn} : 0 ;
+
+    if ($socket) {
+        &Info("Con $Conn: Socket shutdown");
+        shutdown( $socket , 2 );
+
+    } else {
+        &Info("Con $Conn: Socket still shutdown");
+    }
+    delete $conn{$Conn} ;
+    delete $timeout{$Conn} ;
+}
+
+sub NotConnected {
+    my $self = shift ;
+    my $Conn = shift ;
+    my $socket = defined($conn{$Conn}) ? $conn{$Conn} : 0 ;
+    if ($socket) {
+        $! = 0 ;
+        my $scheck = '' ;
+        vec($scheck,fileno($socket),1) = 1;
+        unless (select( $scheck , undef , undef, 0)) {
+            &UPSTAT('IS-CONNECTED');
+            &UPSTAT('CON-errno-'.int($!)."-$!") if $! ;
+            return 0 ;
+        }
+        &Debug("Con $Conn: ".int($!)." - $!") if $! ;
+    }
+
+    &UPSTAT('IS-DISCONNECTED');
+    &Debug("Con $Conn: Connection lost");
+    return 1 ;
+}
+
+sub GetRequest {
+    my $self     = shift ;
+    my $Requests = shift ;
+    my $Ret      = undef ;
+
+    # Check to touch LISTENER time access
+    if ( @timer and &tv_interval(\@timer) > 10 ) {
+        if ( utime undef, undef, $LISTENER ) {
+            @timer = &gettimeofday() ;
+
+        } else {
+            &Warn("Can't touch '$LISTENER' socket: $!");
+            # Won't touch anymore the socket after one error
+            @timer = () ;
+        }
+    }
+
+    # Check connections time out
+    map {
+        if ( &tv_interval($timeout{$_}) > $CLIENT_TIMEOUT ) {
+            $clientrequest = $_ ;
+            if ($self->Answer("ANSWERED REQUEST TIME OUT")) {
+                &Info("Reach time out for connection $_");
+                $self->CloseClient($_,$CLIENT_TIMEOUT,
+                    "ANSWERED REQUEST TIME OUT for $_ client");
+                $! = 0 ;
+
+            } else {
+                &Debug("Deleting still closed $_ connection");
+                $self->CloseClient($_);
+            }
+
+        } elsif ($self->NotConnected($_)) {
+            &Debug("Deleting lost $_ connection");
+            $self->CloseClient($_);
+        }
+    } keys(%timeout);
+
+    # Reset client request id flag
+    $clientrequest = 0 ;
+
+    my ( $Client , $addr );
+    if ( ! defined($Ret = $self->ReadSock($Requests))
+    and keys(%conn) < $MAXCONNECTIONS ) {
+
+        foreach my $Server ( @{$self->{SERVERS}} ) {
+
+            # Accept should not be blocking
+            $Server->blocking(0);
+
+            if ( $addr = accept($Client,$Server) ) {
+
+                bless $Client , "IO::Socket" ;
+                $Client->autoflush(1);
+
+                # Check client as the right to access us
+                # in the case of TCP/IP server
+                if ( $USE_TCPIP_SOCKET and $Server == $self->{TCPSERVER} ) {
+                    my($port,$ip) = sockaddr_in($addr);
+                    # If use_only_loopback is set, it is safe to accept
+                    # Otherwise check other authorized ips
+                    unless ( $USE_ONLY_LOOPBACK or $ANY_OK
+                    or grep { /^$ip$/ } @AUTHORIZED ) {
+                        &Warn("Blocking $ip without access authorization");
+                        shutdown( $Client , 2 );
+                        next ;
+                    }
+                }
+
+                my $ConnId ;
+                # ConnId is unique in one listener thread
+                do {
+                    $ConnId = "CONN" . uc(&ShortID(5))
+                } until ( ! defined($conn{$ConnId}) );
+
+                &Info("Con $ConnId: Got connection with a client");
+                &Debug("Got connection $ConnId on " . $Client);
+
+                $Ret = $self->ReadSock($Client) ;
+                $conn{$ConnId} = $Client ;
+                $timeout{$ConnId} = [ &gettimeofday() ] ;
+                $clientrequest = $ConnId if (defined($Ret));
+
+                last ;
+            }
+        }
+    }
+
+    # Now eventually get request from opened connections
+    if (!defined($Ret)) {
+        foreach my $ConnId (keys(%conn)) {
+            $Client = $conn{$ConnId} ;
+            if (defined($Ret = $self->ReadSock($Client))) {
+                $clientrequest = $ConnId ;
+                last ;
+            }
+        }
+    }
+
+    return $MUSTQUIT ? 1 : $Ret ;
+}
+
+sub XML {
+    my $self   = shift ;
+    my $buffer = shift || "" ;
+
+    # Handle external XML request
+    if ( $clientrequest and $jobcount < $MAXJOBS) {
+        &Debug("Got an external XML request");
+
+        # We have to concatenate any other lines until got a valid xml request
+        # 1. First create XML object
+        my $XML = $XML{$clientrequest} = new A2P::XML(\$buffer);
+
+        # 2. Concatenate on the buffer to get the all XML
+        # Remove any tag corresponding to XML version
+        $buffer =~ s|<\?xml\s.*\?>|| ;
+
+        my $Client = $conn{$clientrequest} ;
+        $buffer = $self->ReadSock($Client) unless ( $buffer =~ m|^<\w+| );
+
+        # Found XML root node to know how XML should be closed
+        my ( $root ) = $buffer =~ m|^<(\w+)\s*[^>]*/*>| ;
+
+        unless (defined($root) and $root) {
+            $self->ThisError("Can't find XML root in '$buffer' XML request");
+            $buffer = "<a2p/>" ;
+            $XML->isA2P ;
+            $XML->A2Pmessage("A2P-ABTERM = NO XML ROOT FOUND");
+            $self->XMLanswer($clientrequest);
+            $self->CloseClient($clientrequest);
+            return 0 ;
+        }
+
+        &Debug("'$root' XML root node found");
+
+        # Only concatenate if we don't get empty root node
+        unless ( $buffer =~ m|^<($root)[^>]*/>| ) {
+            my $line = "" ;
+
+            # Get next content on socket until agregation seems finalized as xml
+            while (defined($Client) and $Client
+            and defined($line) and $line !~ m|</$root>| ) {
+
+                # Loop on socket
+                $line = $self->ReadSock($Client) ;
+
+                &Debug("Concatenate XML with '$line'");
+                $XML->concatenate($line . "\n");
+            }
+        }
+
+        &Debug("Full request is '$buffer'") unless (length($buffer)>100);
+
+        unless ( $XML->isA2P ) {
+            my $abterm = "XML request is not for me" ;
+            $self->ThisError($abterm);
+            $XML->A2Pmessage("A2P-ABTERM = $abterm");
+            $XML->A2Pabterm ;
+            $self->XMLanswer($clientrequest);
+            $self->CloseClient($clientrequest);
+            return 0 ;
+        }
+
+        if ( $XML->getPATH ) {
+
+            my $file = $XML->getPATH ;
+            if ( -e $file ) {
+                # Ask to do the job
+                my $request = &GetCom( comASK ,
+                    JobManager => &GetCom( comJOB , $XML->getid , $file ));
+                $self->Do( \$request ); # This also update jobcount
+
+            } else {
+                my $abterm = "Can't convert not existing '$file'" ;
+                $self->ThisError($abterm);
+                $XML->A2Pmessage("A2P-ABTERM = $abterm");
+                $XML->A2Pabterm ;
+                $self->XMLanswer($clientrequest);
+                $self->CloseClient($clientrequest);
+                return 0 ;
+            }
+
+        } else {
+            my $abterm = "Mal-formed XML request not supported" ;
+            $self->ThisError($abterm);
+            $XML->A2Pmessage("A2P-ABTERM = $abterm");
+            $XML->A2Pabterm ;
+            $self->XMLanswer($clientrequest);
+            $self->CloseClient($clientrequest);
+            return 0 ;
+        }
+
+    } elsif ($clientrequest) {
+        &Warn("Closing $clientrequest as max jobs count has been reached");
+        &Debug("Closing $clientrequest as $jobcount jobcount >= to $MAXJOBS");
+        $buffer = "<a2p/>" ;
+        my $XML = $XML{$clientrequest} = new A2P::XML(\$buffer);
+        $XML->isA2P ;
+        $XML->A2Pmessage("A2P-ABTERM = MAX JOBS COUNT REACHED ON A2P SERVICE");
+        $self->XMLanswer($clientrequest);
+        $self->CloseClient($clientrequest);
+
+    } else {
+        $self->ThisError("[DEV] Unexpected such '$buffer' XML request");
+    }
+}
+
+my $qr_version_event =
+    qr/Step 2, Processing AFP JOB '([-a-zA-Z0-9._]+)' with a2p v([0-9.]+)/ ;
+
+sub XMLEvent {
+    my $self  = shift ;
+    my $conn  = shift ;
+    my $event = shift ;
+
+    unless (defined($XML{$conn})) {
+        &Warn("Can't handle '$event' XML event as '$conn' XML is destroyed");
+        return 0 ;
+    }
+
+    my $XML = $XML{$conn} ;
+
+    # Get version and jobname if available
+    # Pattern: Step 2, Starting AFP JOB '$jobname' with a2p v$version
+    return $XML->A2Pmessage( "A2P-Version = $2", "A2P-Jobname = $1" )
+        if ( $event =~ $qr_version_event );
+
+    # Log any ABTERM event
+    if ( $event =~ /abterm:\s*(.*)$/i ) {
+        $XML->A2Pmessage("A2P-ABTERM = $1");
+        return $XML->A2Pabterm ;
+    }
+
+    # Get zipfile
+    return $XML->A2Pmessage("A2P-Zipfile = $1")
+        if ( $event =~ /ZIPFILE=(.*)$/ );
+
+    # Get PDF for each task
+    # Pattern: Generating PDF '$PDFNAME'
+    return $XML->A2Ppdf( $1 )
+        if ( $event =~ /Generating PDF '([-a-zA-Z0-9._]+\.pdf)'/ );
+
+    # Finally check state and return answer to client
+    if ( $event =~ /JOBSTATUS:\s+(\w+)/ ) {
+        my $state = $1 ;
+        $XML->A2Pmessage( "A2P-State = $state" );
+        $XML->setstate( $state );
+        $self->XMLanswer($conn);
+
+    } else {
+        &Debug("Forgetting info '$event'");
+    }
+}
+
+sub XMLanswer {
+    # Return answer and remove XML object
+    my $self = shift ;
+    my $conn = shift ;
+    my $Socket = $conn{$conn} ;
+    my $XML    = $XML{$conn} ;
+    if (defined($Socket) and defined($XML)) {
+        $Socket->autoflush(1);
+        print $Socket $XML->A2Panswer(), "\n";
+
+    } elsif (!defined($Socket)) {
+        &Warn("Can't send XML answer on '$conn' connection as it seems lost");
+
+    } else {
+        &Warn("Can't send XML answer on no XML was defined");
+    }
+    delete $XML{$conn} ;
+}
+
+sub Answer {
+    my $self = shift ;
+
+    my $Socket = $clientrequest ? $conn{$clientrequest} : $self->{DADDY} ;
+    return 0 unless (defined($Socket));
+
+    my @Answer =
+        &GetCom( comCOM , $$ => ( @_ > 1 ? &GetCom( comREQ , @_ ) : $_[0] ));
+
+    my $Ret = $clientrequest ? print $Socket @Answer,"\n" :
+        $self->PrintSock( $Socket, @Answer )
+        or &Debug("Listener answer not sent, ".__PACKAGE__.
+            ", l. ".__LINE__." ($!-$?-$@)");
+
+    &Debug("Bad listener answer request: @_") if ( $#_ > 1);
+
+    return $Ret ;
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
Index: /A2P/a2p/A2P/Logger.pm
===================================================================
--- /A2P/a2p/A2P/Logger.pm	(revision 3)
+++ /A2P/a2p/A2P/Logger.pm	(revision 3)
@@ -0,0 +1,174 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+package A2P::Logger ;
+
+# Derived class from Thread.pm
+use base qw(A2P::Thread);
+
+use strict ;
+use integer ;
+use Time::HiRes qw( gettimeofday tv_interval ) ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use A2P::Com qw( IsCom GetCom comREQ comCOM comLOG );
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 415 $ =~ /(\d[0-9.]+)\s+/ ;
+}
+our $VERSION ;
+
+# These are the ordered levels to cache ( info, debug)
+my @LevelToCache = ( 6 , 7 );
+
+#############################################################################
+##          Logger code                                                    ##
+#############################################################################
+
+sub ThreadInitEarly {
+    my $self = shift ;
+    # Set $loggertid to enable direct call to syslog in DirectLog from A2P::Syslog.pm
+    $loggertid = $$ ;
+    &SetLogger( $self );
+
+    # Initializes our cache
+    $self->{CACHETIMER} = [ &gettimeofday() ];
+    $self->{CACHE} = {} ;
+
+}
+
+sub Do {
+    my $self = shift ;
+    my $ref  = shift ;
+
+    my $Ret = 0 ;
+
+    my @Log = &IsCom( comLOG , $$ref );
+
+    if ( @Log == 2 ) {
+
+        &UPSTAT('GETCOMLOG');
+
+        if ( grep { $_ == $Log[0] } @LevelToCache ) {
+            # Cache this log
+            push @{$self->{CACHE}->{$Log[0]}}, $Log[1] ;
+
+        } else {
+            # Log immediatly if necessary
+            if ( $Log[0] =~ /^\d+/ ) {
+                &DirectLog( $Log[0] , [ $Log[1] ] );
+
+            } else {
+                local $" = "' -> '" ;
+                &Warn("Can't log '@Log'");
+                &debugdev("Can't log '@Log'");
+            }
+        }
+
+        $Ret ++ ;
+
+    } else {
+        &Error("Can't interpret log request '$$ref'");
+    }
+
+    return $Ret ;
+}
+
+sub DoLog {
+    my $self = shift ;
+    &UPSTAT('DOLOG');
+
+    my $log = &GetCom( comREQ , TODO , @_ );
+    return $self->PrintSock( $self->{SON}, $log ) if ( $$ == $maintid );
+
+    &debugdev("Not expected to handle '$log' from here");
+    &UPSTAT('DOLOG-ERROR');
+    return 0 ;
+}
+
+sub GetRequest {
+    my $self     = shift ;
+    my $Requests = shift ;
+
+    return 1 if ( $MUSTQUIT or $self->{DO_QUIT} );
+
+    my $read = $self->ReadSock($Requests);
+
+    # Flush our log cache if no more log is available or more than 1 sec has passed
+    $self->FlushCache() if ( %{$self->{CACHE}} and
+        ( ! $read or &tv_interval($self->{CACHETIMER}) >= 1) );
+
+    return $read ;
+}
+
+sub FlushCache {
+    my $self   = shift ;
+    &UPSTAT('FLUSH-LOG-CACHE');
+
+    # Log cache for each cached level
+    foreach my $level (keys(%{$self->{CACHE}})) {
+
+        # Check cached messages
+        unless ( grep { $_ =~ /^$level$/ } @LevelToCache ) {
+            &debugdev("Can't flush info at level <$level>");
+        }
+
+        if (@{$self->{CACHE}->{$level}}) {
+            &UPSTAT('FLUSH-LINE-LEVEL-'.$level,scalar(@{$self->{CACHE}->{$level}}));
+            &DirectLog( $level , $self->{CACHE}->{$level} );
+
+            # Empty cache for that level
+            @{$self->{CACHE}->{$level}} = [] ;
+        }
+        delete $self->{CACHE}->{$level} ;
+    }
+
+    # Reset timer
+    $self->{CACHETIMER} = [ &gettimeofday() ];
+}
+
+sub DoBeforeQuit {
+    my $self   = shift ;
+
+    $self->FlushCache();
+
+    # Purge message in log queue
+    my @Logs = $self->ReadSock($self->{DADDY});
+    close($self->{DADDY});
+
+    map {
+        my $log = $_ ;
+        chomp $log;
+        my @Req = &IsCom( comREQ , $log );
+        if ( @Req ) {
+            my @Log = &IsCom( comLOG , $Req[1] );
+            &DirectLog( $Log[0] , [ $Log[1] ] , "Purging:" ) if ( $Log[1] );
+        }
+    } @Logs ;
+
+    # Close Syslog socket
+    shutdown($SYSLOG,2) if (defined($SYSLOG));
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
Index: /A2P/a2p/A2P/Signal.pm
===================================================================
--- /A2P/a2p/A2P/Signal.pm	(revision 3)
+++ /A2P/a2p/A2P/Signal.pm	(revision 3)
@@ -0,0 +1,187 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+package A2P::Signal;
+
+use strict ;
+use integer ;
+use Carp qw(longmess);
+use sigtrap qw(any normal-signals error-signals old-interface-signals IO URG CLD CHLD);
+use A2P::Globals ;
+use A2P::Syslog ;
+
+BEGIN {
+    use Exporter ();
+
+    our ( $VERSION , @ISA , @EXPORT , @EXPORT_OK );
+
+    $VERSION = sprintf "%s", q$Rev: 1029 $ =~ /(\d[0-9.]+)\s+/ ;
+
+    @ISA = qw(Exporter);
+    @EXPORT    = qw(  $do_init   $do_check  $do_quit  $do_ping  $do_test
+        $Childquit    @SigDebug  @SigInfo   @SigWarn  @PIPE     );
+    @EXPORT_OK = qw(&LogSigMessage);
+}
+our $VERSION ;
+
+#############################################################################
+##          Signal handling vars                                           ##
+#############################################################################
+our @SigDebug  = ();
+our @SigInfo   = ();
+our @SigWarn   = ();
+
+# Socket list to be checked when receiving a SIGPIPE
+our @PIPE ;
+
+# Some used flags
+our $do_init   = 1 ;
+our $do_check  = 1 ;
+our $do_quit   = 0 ;
+our $do_ping   = 0 ;
+our $do_test   = 0 ;
+our $Childquit = 0 ;
+
+#############################################################################
+##          Signal handling code                                           ##
+#############################################################################
+sub SigABRT {
+    $do_quit += 5 ;
+    push @SigWarn , "SIGABRT: Notified to abort ($do_quit)";
+    $MUSTQUIT ++ ;
+    exit(1) if ( $do_quit > 9 );
+    $NO_SYSLOG_DEBUG = 0 if $SERVICE_DEBUG ;
+}
+
+sub SigQUIT {
+    push @SigDebug , "Notified to quit by 'SIG$_[0]' signal";
+    exit(1) if ( ++ $do_quit > 3 );
+}
+
+sub SigHUP {
+    push @SigDebug , "SIGHUP received";
+    $do_init ++ ;
+    my $touch_file = $SERVICE_TMP . '/init_' . $Progname ;
+    if ( -d $SERVICE_TMP and -e $touch_file ) {
+        my $now = time ;
+        utime $now, $now, $touch_file ;
+
+    } else {
+        push @SigWarn  , "Can't touch file '$touch_file' on SIGHUP" ;
+    }
+}
+
+sub SigALRM {
+    $do_check ++ if $DO_PING ;
+    push @SigDebug , "SIGALRM received";
+}
+
+sub SigDIE {
+    my $info = $_[0] || "" ;
+    my $sub ;
+    chomp $info ;
+
+    # Forget DIE signal when loading Storable.pm and Log/Agent.pm not present
+    return if ( $info =~ /Log\/Agent.pm/ );
+
+    my ($package, $filename, $line) = caller();
+
+    # Forget Encoding integration signal...
+    return if ( $filename =~ /Encode.pm/ );
+
+    # As a thread should has shutdown, we should check our services
+    ++ $do_check ;
+
+    push @SigWarn  , "Got '__DIE__' signal", &longmess(@_) ;
+}
+
+sub SigPIPE {
+    my ($package, $filename, $line) = caller();
+    push @SigDebug , "SIG@_ received at L. $line in $filename: $! $?" ;
+    unless ( grep { defined($_) } @PIPE ) {
+        push @SigWarn  , "Got '$_[0]' signal" ;
+        $MUSTQUIT ++ ;
+    }
+}
+
+sub SigINT {
+    # Just print info in log about where we were called
+    &Info("debug: SIG" . &longmess(@_));
+}
+
+sub SigWARN {
+    push @SigWarn  , "Got '__WARN__' signal", &longmess(@_) ;
+}
+
+sub SigUSR1 {
+    $do_test ++ ;
+}
+
+my $templogger = 0 ;
+my $temp_NO_SYSLOG_DEBUG = $NO_SYSLOG_DEBUG ;
+sub SigUSR2 {
+    push @SigInfo  , "Got 'USR2' signal", &longmess(@_) ;
+    $templogger = $loggertid if $loggertid ;
+    $loggertid = $loggertid ? 0 : $templogger ;
+    # Switch advanced debugging mode
+    if ( $ADVANCED_DEBUGGING = $ADVANCED_DEBUGGING ? 0 : 1 ) {
+        $temp_NO_SYSLOG_DEBUG = $NO_SYSLOG_DEBUG ;
+        $NO_SYSLOG_DEBUG = 0 ;
+    } else {
+        $NO_SYSLOG_DEBUG = $temp_NO_SYSLOG_DEBUG ;
+    }
+    &debugdev("ADVANCED_DEBUGGING=$ADVANCED_DEBUGGING NO_SYSLOG_DEBUG=$NO_SYSLOG_DEBUG");
+}
+
+map {
+    eval q|$SIG{'| . $_ . q|'} = \&Sig| . $_
+} qw( PIPE ABRT QUIT HUP ALRM USR1 USR2 );
+
+$SIG{'INT'}      = \&SigINT  ;
+$SIG{'SEGV'}     = \&SigPIPE ;
+$SIG{'TERM'}     = \&SigQUIT ;
+$SIG{'__DIE__'}  = \&SigDIE  ;
+$SIG{'__WARN__'} = \&SigWARN ;
+$SIG{'CHLD'}     = sub { $Childquit ++ } ;
+
+sub _log_list {
+    my $callback = shift ;
+    my $list = shift ;
+    my %mesg = () ;
+    while (@{$list}) {
+        my $message = shift @{$list} ;
+        next unless (defined($message) and $message);
+        $mesg{$message} = 0 unless (exists($mesg{$message}));
+        &$callback($message.
+            (($mesg{$message}++) ?" ($mesg{$message} times)" : "" ));
+    }
+}
+
+sub LogSigMessage {
+    &_log_list( \&Warn,  \@SigWarn  );
+    &_log_list( \&Info,  \@SigInfo  );
+    &_log_list( \&Debug, \@SigDebug );
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
Index: /A2P/a2p/A2P/SpoolManager.pm
===================================================================
--- /A2P/a2p/A2P/SpoolManager.pm	(revision 3)
+++ /A2P/a2p/A2P/SpoolManager.pm	(revision 3)
@@ -0,0 +1,567 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+package A2P::SpoolManager;
+
+# Derived class from Thread.pm
+use base qw(A2P::Thread);
+
+use strict;
+use Fcntl;
+use Fcntl          qw( :DEFAULT );
+use Time::HiRes    qw( usleep gettimeofday );
+use A2P::Globals;
+use A2P::Syslog;
+use A2P::Tools   qw( FcntlLocked WaitFcntlLocked FcntlUnlocked);
+use A2P::Com     qw( IsCom comJOB );
+use A2P::JobStatus 'a2pjobstate' ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 415 $ =~ /(\d[0-9.]+)\s+/ ;
+}
+our $VERSION ;
+
+#+--------------------------------------------------------------------------+
+#|             Private helpers for file locking                             |
+#+--------------------------------------------------------------------------+
+sub get_locked (\$) {
+    &TIMESTAT('LOCKING-FILE');
+    my $self = shift ;
+    my $ref  = shift ;
+    my $ret  = 1 ;
+    my $LCK ;
+    my $prefix   = &prefix($$ref);
+    my $filename = $AFPSPOOL . '/' . $$ref ;
+    $filename =~ s$//$/$g ; # Clean filename
+
+    # First lock on prefix
+    unless ($self->lockprefix($prefix)) {
+        &Debug("prefix '$prefix' not locked");
+        &TIMESTAT('LOCKING-FILE');
+        return 0 ;
+    }
+
+    unless ( -e $filename ) {
+        &Debug("'$filename' not found");
+        $self->unlockprefix($prefix);
+        &TIMESTAT('LOCKING-FILE');
+        return 0 ;
+    }
+
+    my $lockfile = $AFPSPOOL . "/.a2p/" . $$ref . ".LCK" ;
+    sysopen( $LCK , "$lockfile" , O_WRONLY | O_CREAT )
+        or $ret = &Error("Can't open '$lockfile' for writing: $!");
+
+     if ( $ret ) {
+        &Debug("Trying to get a lock on '$lockfile'");
+        if ( $ret and &FcntlLocked($LCK)) {
+            truncate($LCK,0);
+
+            my $newname = $filename ;
+
+            # Replace "prefix." string by LOCKID folder name
+            $newname =~ s|/$prefix\.|/$LOCKID/| ;
+            &Debug("Renaming '$filename' to '$newname'");
+            unless (rename $filename , $newname) {
+                &Debug("Can't rename '$$ref': $!");
+                $ret = 0 ;
+            }
+
+            if ( $ret and -e $newname ) {
+                $newname =~ s,$AFPSPOOL/*,, ; # Keep only filename
+                $$ref = $newname ;
+                &Debug("'$newname' locked");
+
+            } else {
+                &Debug("'$newname' not available");
+                $ret = 0 ;
+            }
+
+        } else {
+            &Debug("Can't lock '$lockfile': $!");
+            $ret = 0 ;
+        }
+
+        # Remove lock file
+        close($LCK);
+        unlink $lockfile ;
+    }
+
+    unless ($self->unlockprefix($prefix)) {
+        &Warn("Can't unlock prefix on $prefix before locking on $filename: $!");
+        &Info("$prefix file must be deleted manually " .
+            "after all concerned services has been stopped");
+    }
+
+    &TIMESTAT('LOCKING-FILE');
+    return $ret ;
+}
+
+sub lockname {
+    my $self = shift ;
+
+    my $LCK ;
+    my $lock = $AFPSPOOL . '/' . $_[0] ;
+
+    &Debug("'$_[0]' seems still locked") if ( -s $lock . '.LCK' );
+
+    sysopen( $LCK , $lock . ".LCK" , O_WRONLY | O_CREAT )
+        or &Error("Can't open '$lock.LCK' for writing: $!"), return "";
+
+    if(!&FcntlLocked($LCK)) {
+        &Error("Can't lock '$lock.LCK': $!");
+        return "";
+    }
+
+    truncate $LCK , 0 ;
+
+    # Print our PID in Spool Lock File
+    print $LCK $$ ;
+
+    $self->{LOCKEDSPOOL} = $LCK ;
+
+    # Create folder where will be moved files if needed
+    if ( ! -d $lock ) {
+        mkdir $lock , 0775
+            or &Error("Can't create '$lock' folder: $!"), return "";
+    }
+
+    return $lock ;
+}
+
+my @prefix = () ;
+sub prefix {
+    my $file = shift ;
+    map { return $1 if $file =~ /^($_)\..+/i } @prefix ;
+    return "" ;
+}
+
+sub update_prefix {
+    # Update prefix array as optimization and SPOOL_PREFIX can has been updated
+    return @prefix = split( /\s+/, $_[0] ) ;
+}
+
+################################################################################
+##          Afpspool file handling code                                       ##
+################################################################################
+sub Do {
+    my $self = shift ;
+    my $ref  = shift ;
+
+    my ( $count , $lastwasmax ) = ( 0 , 1 );
+
+    my $file = "" ;
+    my $AfpName = "" ;
+
+    my @Job = &IsCom( comJOB , $$ref );
+
+    # Default request is give me a filename for that job
+    if ( @Job ) {
+
+        if ( $Job[1] == DONE ) {
+            # Reset last kept information to skip annoying alert before quitting
+            # The JobManager is saying it is managing the file, so it will keep
+            # trace of it even if it should quit or abort
+            ( $self->{LASTJOB} , $self->{LASTFILE} ) = ( $Job[0] , NOMOREFILE );
+            $self->AnswerDone( $Job[0] );
+            return 1 ;
+        }
+
+        # Keep internal stats
+        &UPSTAT('SPOOL_CHECK');
+
+        # Locking AFPSPOOL for our LOCKID
+        if (!defined($self->{LockedSpool}->{$AFPSPOOL})) {
+
+            # Unlock old spool, needed if AFPSPOOL is updated
+            $self->DoBeforeQuit();
+
+            # LOCKID will also be a folder in AFPSPOOL, see &get_locked
+            $self->{LockedSpool}->{$AFPSPOOL} = $self->lockname("$LOCKID") ;
+            if ( $self->{LockedSpool}->{$AFPSPOOL} ) {
+                &Debug("'$AFPSPOOL' locked with '$LOCKID' lockid");
+
+            } else {
+                $self->ThisError("Can't lock '$AFPSPOOL' folder on '$LOCKID'");
+                &Alert("Quitting as AFPSPOOL is not available," .
+                    " maybe LOCKID is still allocated to another service");
+
+                # Tell there's nothing we can do
+                $self->Return( $Job[0] , 1 );
+
+                delete $self->{LockedSpool}->{$AFPSPOOL};
+                $MUSTQUIT ++ ; # Fatal error thread should quit
+            }
+        }
+
+        # Update prefix array as optimization and needed when SPOOL_PREFIX
+        # has been updated
+        &update_prefix($SPOOL_PREFIX);
+
+        &Debug("Finding a file for job $Job[0]");
+
+        while (length($file) == 0) {
+            $count = scalar( @{$self->{AfpFiles}} );
+
+            # Update the cache if needed
+            if ( $count == 0 or ( $count < $MINFOLDERCOUNT and $lastwasmax ) ) {
+                my @LockedFiles = () ;
+                # Set timestamp to MAXRETRYTIMER millisecond earlier
+                my $timestamp   = &gettimeofday()*1000 - $MAXRETRYTIMER ;
+
+                # Spawn command to get files ordered by age from afpspool
+                my $Command = "ls -t1r " . $AFPSPOOL ;
+                &Debug("Starting '$Command' to get file list in spool");
+                open(CMD, "$Command 2>/dev/null |")
+                    or &Alert("Can't start \"$Command\" command"), return ;
+
+                foreach $file (<CMD>) {
+                    chomp($file);
+                    &Debug("Checking '$file' is for us");
+
+                    # Skip our LOCKID locking file
+                    next if ( $file =~ /^$LOCKID\.LCK$/ );
+
+                    # Remove the path from file
+                    $file =~ s/$AFPSPOOL\/*// ;
+
+                    # Keep file only if its prefix match one from the list
+                    my $prefix = &prefix($file) ;
+                    next unless ($prefix);
+
+                    # Keep only not locked files and remove it if in list as
+                    # it is just locked by another thread
+                    if ( $file =~ /^(.*).LCK$/i ) {
+                        $file = $1 ;
+                        push @LockedFiles , $file ;
+                        @{$self->{AfpFiles}} = grep { ! /^$file$/ }
+                            @{$self->{AfpFiles}} ;
+                    }
+
+                    # Skip if file is still in our lists
+                    next if ( defined($self->{AfpName}->{$file}) and
+                        $self->{AfpName}->{$file} );
+
+                    # Same computation as in afpds2tex module
+                    my ( $basename ) = $file =~ /^$prefix\.(.*)$/ ;
+                    ( $AfpName ) = $basename =~ $AFPNAME_REGEX ;
+
+                    unless (defined($AfpName) and $AfpName) {
+                        &Error("Can't set an afpname with '$file', skipping");
+                        next ;
+                    }
+
+                    $self->{AfpName}->{$file} = $AfpName ;
+                    push @{$self->{AfpFiles}} , $file ;
+                    $self->{Timestamp}->{$file} = $timestamp ;
+                    &Debug("'$file' added to listing as '$AfpName' Jobname");
+
+                    last if ( ++$count >= $MAXFOLDERCOUNT );
+                }
+                $lastwasmax = $count >= $MAXFOLDERCOUNT ? 1 : 0 ;
+
+                close(CMD);
+            }
+
+            # Check files availability
+            if (scalar( @{$self->{AfpFiles}} )) {
+                my $found = 0 ;
+                my @keep = () ;
+
+                # Loop to try first file from list
+                while (scalar( @{$self->{AfpFiles}} )) {
+                    $file = shift(@{$self->{AfpFiles}});
+                    $AfpName = $self->{AfpName}->{$file} ;
+
+                    my $file_time = $self->{Timestamp}->{$file} ;
+                    my $can_try = &gettimeofday()*1000 - $file_time ;
+                    # Select available file by trying to lock it
+                    if ( $can_try >= $MAXRETRYTIMER
+                    and $self->get_locked(\$file)) {
+                        # file has been updated by &get_locked
+                        &Debug("Found '$file' for Job $Job[0]");
+                        $found ++ ;
+                        last ;
+
+                    } elsif ( $can_try >= $MAXRETRYTIMER ) {
+                        # Set file tried and will only retry later
+                        $self->{Timestamp}->{$file} += $can_try ;
+                    }
+
+                    if ( -e $file ) {
+                        push @keep, $file ;
+
+                    } else {
+                        delete $self->{Timestamp}->{$file} ;
+                        # Release also the AfpName
+                        delete $self->{AfpName}->{$file} ;
+                    }
+                }
+
+                # Store kept files
+                if ( @keep ) {
+                    &Debug("Files to retry later: @keep");
+                    unshift @{$self->{AfpFiles}}, @keep ;
+                }
+
+                if ($found) {
+                    # Keep internal stats
+                    &UPSTAT('SPOOL_GOT_FILE');
+
+                    # Initialize jobstatus with AfpName to keep restarts in mind
+                    &a2pjobstate( $AfpName , 1 , 'o',
+                        {
+                            AFP    => $AfpName,
+                            JOBID  => $Job[0],
+                            STATUS => 'STARTING',
+                            FILE   => $file,
+                            INFOS  => 'Started'
+                        } )
+                        or &Info("Can't initialize '$Job[0]' job status");
+
+                    # We must remove now unused keys retrieving the first key
+                    map {
+                        # Release this AfpName
+                        delete $self->{AfpName}->{$_} ;
+
+                        # Release cache timestamp
+                        delete $self->{Timestamp}->{$_} ;
+
+                    } grep { $self->{AfpName}->{$_} eq $AfpName }
+                        keys(%{$self->{AfpName}});
+
+                    last ;
+
+                } else {
+                    &Debug("No available file found for Job $Job[0]");
+                    $file = NOMOREFILE ;
+
+                    # Keep internal stats
+                    &UPSTAT('SPOOL_GOT_NOFILE');
+
+                    # Check available timestamp
+                    my $time_count = keys(%{$self->{Timestamp}}) ;
+                    unless ( $time_count == @{$self->{AfpFiles}}) {
+                        my $diff = $time_count - @{$self->{AfpFiles}} ;
+                        &Debug("Found diff between timestamp keys " .
+                          "and available files: $diff", "Keys  = " .
+                          join(' ',keys(%{$self->{Timestamp}})),
+                          "Files = @{$self->{AfpFiles}}");
+                        &Info("Got available files cache incoherence");
+                        $self->{AfpFiles}  = [] ;
+                        $self->{Timestamp} = {} ;
+                        $self->{'AfpName'} = {} ;
+                    }
+                }
+
+            } else {
+                &Debug("No file found for Job $Job[0]");
+                $file = NOMOREFILE ;
+
+                # Keep internal stats
+                &UPSTAT('SPOOL_GOT_NOFILE');
+            }
+
+        } # Until file set or state is nomorefile
+        $self->Return( $Job[0] , $file );
+        $self->AnswerDone( $Job[0] );
+
+        # Keep last information to check it before quitting
+        ( $self->{LASTJOB} , $self->{LASTFILE} ) = ( $Job[0] , $file );
+
+    } else {
+        $self->ThisError("Can't do unsupported request '$$ref'");
+
+        # Keep internal stats
+        &UPSTAT('SPOOL_CHECK_BADREQFORMAT');
+    }
+
+    return $file ;
+}
+
+sub openLockingPrefix {
+    my $self = shift ;
+
+    # First lock the locking folder
+    my $lock = $AFPSPOOL . '/.a2p/.LCK' ;
+    my $LCK ;
+    sysopen( $LCK, $lock , O_WRONLY | O_CREAT )
+        or return &Error("Can't open lock in shared folder in spool: $!");
+
+    return &Error("Can't get lock on shared folder in spool: $!")
+        unless (&WaitFcntlLocked($LCK));
+
+    # Create prefix locking files when required with uppercase filename
+    foreach my $prefix ( map { uc } (@_? @_ : &update_prefix($SPOOL_PREFIX)) ) {
+        my $file = $AFPSPOOL . '/.a2p/' . $prefix . '.LCK' ;
+        # Don't try to reopen file
+        next if (-e $file and defined($self->{LockingPrefix}->{$prefix}));
+        sysopen( $self->{LockingPrefix}->{$prefix} , $file , O_WRONLY|O_CREAT )
+            or &Error("Can't open prefix lock in shared folder: $!");
+        $self->{LockFileName}->{$prefix} = $file ;
+    }
+
+    # Release lock on locking prefix folder
+    return &Error("Can't release lock on shared folder in spool: $!")
+        unless (&FcntlUnlocked($LCK));
+
+    close($LCK)
+        or &Warn("Found problem when closing locking file in spool: $!");
+
+    1 ;
+}
+
+sub closeLockingPrefix {
+    my $self = shift ;
+
+    # First lock the locking folder
+    my $lock = $AFPSPOOL . '/.a2p/.LCK' ;
+    my $LCK ;
+    sysopen( $LCK, $lock , O_WRONLY | O_CREAT )
+        or return &Error("Can't open lock in shared folder in spool: $!");
+
+    return &Error("Can't get lock on shared folder in spool: $!")
+        unless (&WaitFcntlLocked($LCK));
+
+    foreach my $prefix ( keys(%{$self->{LockingPrefix}}) ) {
+        &FcntlUnlocked($self->{LockingPrefix}->{$prefix});
+        close($self->{LockingPrefix}->{$prefix});
+        delete $self->{LockingPrefix}->{$prefix};
+        unlink $self->{LockFileName}->{$prefix};
+    }
+
+    # Release lock on locking prefix folder
+    return &Error("Can't release lock on shared folder in spool: $!")
+        unless (&FcntlUnlocked($LCK));
+
+    close($LCK)
+        or &Warn("Found problem when closing locking file in spool: $!");
+
+    1 ;
+}
+
+sub lockprefix {
+    &TIMESTAT('LOCKING-PREFIX');
+    my $self   = shift ;
+    my $prefix = uc(shift) ;
+
+    sub locktest ;
+    *locktest = $WAIT_ON_PREFIX ? \&WaitFcntlLocked : \&FcntlLocked ;
+
+    &UPSTAT('GET-LOCKING-PREFIX');
+    my ( $try, $locked ) = ( 3, 0 ) ;
+    while ( $try -- ) {
+
+        &openLockingPrefix($self, $prefix)
+            unless ( -e $self->{LockFileName}->{$prefix} );
+
+        unless (defined($self->{LockingPrefix}->{$prefix})) {
+            &openLockingPrefix($self, $prefix);
+            &UPSTAT('BAD-PREFIX-TO-LOCK');
+            next ;
+        }
+
+        if (&locktest($self->{LockingPrefix}->{$prefix})) {
+            &UPSTAT('GOOD-LOCKING-PREFIX');
+            $locked ++ ;
+            last ;
+        }
+
+        &UPSTAT('BAD-LOCKING-PREFIX');
+    }
+
+    &TIMESTAT('LOCKING-PREFIX');
+    return $locked ;
+}
+
+sub unlockprefix {
+    &TIMESTAT('UNLOCKING-PREFIX');
+    my $self   = shift ;
+    my $prefix = uc(shift) ;
+    my $ret    = 1 ;
+    &UPSTAT('GET-PREFIX-UNLOCKING');
+
+    unless (defined($self->{LockingPrefix}->{$prefix})) {
+        &Warn("Can't unlock not defined filehandle");
+        &UPSTAT('BAD-PREFIX-TO-UNLOCK');
+        $ret -- ;
+    }
+
+    if ($ret and &FcntlUnlocked($self->{LockingPrefix}->{$prefix})) {
+        &UPSTAT('GOOD-PREFIX-UNLOCKING');
+    } else {
+        &Warn("Can't unlock prefix '$prefix': $!");
+        &UPSTAT('BAD-PREFIX-UNLOCKING');
+        $ret -- ;
+    }
+
+    &TIMESTAT('UNLOCKING-PREFIX');
+    return $ret ;
+}
+
+sub ThreadInit {
+    my $self = shift ;
+    $self->{AfpFiles}  = [] ;
+    $self->{Timestamp} = {} ;
+    $self->{AfpName}   = {} ;
+
+    $self->{LockingPrefix} = {} unless (defined($self->{LockingPrefix}));
+    $self->{LockFileName}  = {} unless (defined($self->{LockFileName}));
+
+    $self->closeLockingPrefix();
+    $self->openLockingPrefix();
+}
+
+sub DoBeforeQuit {
+    my $self = shift ;
+
+    # Close any prefix and unlock the spool
+    if (defined($self->{LOCKEDSPOOL})) {
+        &closeLockingPrefix();
+        close($self->{LOCKEDSPOOL});
+    }
+
+    map {
+        # Get PID locking this spool, it should be me
+        open PID , $self->{LockedSpool}->{$_} . ".LCK"
+            or delete $self->{LockedSpool}->{$_} ;
+        my ( $pid ) = <PID> ;
+        close PID ;
+        if ( $self->{LockedSpool}->{$_} and $$ =~ /^$pid$/ ) {
+            unlink $self->{LockedSpool}->{$_} . ".LCK" ;
+            delete $self->{LockedSpool}->{$_} ;
+        }
+    } keys(%{$self->{LockedSpool}}) ;
+
+    # Check if last response was a file to process to not forget any job
+    if ( defined($self->{LASTJOB}) and defined($self->{LASTFILE}) ) {
+        if ( $self->{LASTFILE} != NOMOREFILE ) {
+            &Alert("Last request was an AFP job to do, you should check " .
+                $self->{LASTJOB} . " job has been processed with '" .
+                $self->{LASTFILE} . "' AFP file");
+        }
+    }
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
Index: /A2P/a2p/A2P/Status.pm
===================================================================
--- /A2P/a2p/A2P/Status.pm	(revision 3)
+++ /A2P/a2p/A2P/Status.pm	(revision 3)
@@ -0,0 +1,1137 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Class to implement one job status object handling its tied version
+#
+
+package A2P::Status ;
+
+use strict;
+use Storable qw( freeze thaw );
+use Time::HiRes  qw( usleep );
+use A2P::Globals ;
+use A2P::Syslog ;
+use A2P::Tools qw( SharedList FreeSharedList ms );
+use A2P::DB qw( job_status_update is_job_status_updated get_next_jobstatus
+                job_status_delete );
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 1158 $ =~ /(\d[0-9.]+)\s+/ ;
+}
+our $VERSION ;
+
+# Set initial status constant to default array at compilation
+sub INTIAL_STATUS { split(//,'o__00000000__') }
+
+my $CACHE   = {} ;    # Status object cache
+my $TIEHASH = {} ;    # Tied hash
+my $DB      = {} ;    # Status DB informations
+my $SID_INDEX = 0 ;   # Index to initialize status unique ID, only in a2p-status
+my %MESG    = () ;    # Used in StatusDebug to avoid same messages
+
+### Private members related to SID management ###
+# Reference of sid cache list
+sub SID_CACHE { defined($CACHE->{__SID__}) ? $CACHE->{__SID__} :
+    ( $CACHE->{__SID__} = {} ) }
+# Only call _get_sid_tied_key when we are sure first arg is a number
+sub _get_sid_tied_key { '_SID_' . (@_ ? $_[0] : "" ) }
+my $MATCH_SID_TIED_KEY = qr/^_SID_(\d+)$/ ;
+# Revision keys extension
+sub _rev_ext    {   '_rev'  }
+sub _rev_ext_re { qr/_rev$/ }
+#################################################
+
+sub _is_tie_writer {
+    # Status object must not be used before this key is set in cache
+    return ( tied(%$TIEHASH) and defined($CACHE->{__GDBM_WRITER__})
+        and $CACHE->{__GDBM_WRITER__} );
+}
+
+sub new {
+    my $class = shift ;
+    my $self  = undef ;
+
+    # Return if CACHE and TIEHASH are not hash
+    return $self
+        unless (ref($_[0]) =~ /^HASH/ and ref($_[1]) =~ /^HASH/);
+
+    &TIMESTAT('STATUS-GET-NEW');
+
+    $CACHE   = shift ;
+    $TIEHASH = shift ;
+    my $job  = shift || 'noname' ;
+
+    # Try to get the status from CACHE
+    if (defined(SID_CACHE->{$job})) {
+        $self = SID_CACHE->{$job}->check_cached_aged ;
+
+    } elsif (defined($CACHE->{$job})) {
+        $self = $CACHE->{$job}->check_cached_aged ;
+    }
+
+    unless (defined($self)) {
+        # Job not in cache, prepare to check tied hash by constructing a
+        # minimal object
+        $self = { JOB => $job, INITIAL => $job } ;
+        bless $self , $class ;
+        $self->_set_defaults ;
+    }
+
+    $self->is_job($job);
+
+    # Get ourself from tied hash if I was updated in tied hash
+    $self = $self->compared_with_one_from_tiehash ;
+
+    # Keep references in cache when not cached
+    $self->cached unless ($self->is_cached);
+
+    # Check SID: Set to 0 by default unless in a2p-status
+    $self->set_sid_index(&_found_sid) unless (defined($self->get_sid_index));
+
+    # Delete initial tag for newly created object used as ident when destroyed
+    if (exists($self->{INITIAL})) {
+        #&StatusDebug("new Status object v$VERSION created for $job");
+        delete $self->{INITIAL} ;
+    }
+
+    &TIMESTAT('STATUS-GET-NEW');
+    return $self ;
+}
+
+sub _set_defaults {
+    # Be careful, some defaults must only be set the first time
+    my $self = shift ;
+    $self->{JOB}    = "noname"      unless (defined($self->{JOB}));
+    $self->{AFP}    = $self->is_job unless (defined($self->{AFP}));
+    $self->{JOBID}  = ""            unless (defined($self->{JOBID}));
+    $self->{STEP}   = 2  ; # We are still at step when jobstatus is created
+    $self->{STATE}  = [ INTIAL_STATUS ] ;
+    $self->{LOCKID} = $LOCKID ;
+    $self->{DAY}    = 19700101 ;
+    $self->{BORN}   = 0             unless (exists($self->{BORN}));
+    $self->{REV}    = 0             unless (defined($self->{REV}));
+    $self->{TIMER}  = 0             unless (defined($self->{TIMER}));
+    map { $self->unset_dirty_bit($_) } 1..16 ; # Reset dirty bits
+}
+
+sub set_sid_index { # SID must set as a number
+    my $self = shift ;
+    my $sid  = shift ;
+    if (defined($sid) and $sid =~ /^\d+$/) {
+        $self->{SID} = $sid ;
+
+        # Update our predictive internal SID index counter
+        &_found_sid( $sid );
+
+    } elsif (exists($self->{SID})) {
+        delete $self->{SID} ;
+    }
+}
+
+sub get_sid_index { # Must return a number as SID
+    return defined($_[0]->{SID}) ? $_[0]->{SID} : 0 ;
+}
+
+sub get_sid_key {
+    # Return an unique SID key for the tied hash
+    my $self = shift ;
+    return ( $_[0] =~ /^\d+$/ ) ? _get_sid_tied_key($_[0]) : $_[0]
+        if (@_ and $_[0]);
+    # self->AFP is the default SID key
+    return $self->get_sid_index ?
+        _get_sid_tied_key($self->get_sid_index) : ( shift || $self->{AFP} ) ;
+}
+
+sub get_sid_version_key {
+    return (defined($_[1]) ?
+        ( $_[1] =~ /^\d+$/ ? $_[0]->get_sid_key($_[1]) : $_[1] ) :
+        $_[0]->get_sid_key ) . _rev_ext ;
+}
+
+sub _is_revision_key {
+    return $_[0] =~ _rev_ext_re ;
+}
+
+sub _found_sid {
+     # API only useful in a2p-status
+    return ( $_[0] > $SID_INDEX ? $SID_INDEX = shift : shift )
+        if (@_ and $_[0] =~ /^\d+$/);
+    return 0 unless ($SID_INDEX);
+    $SID_INDEX ++ ;
+    return (defined(SID_CACHE->{$SID_INDEX})
+        or defined($TIEHASH->{_get_sid_tied_key($SID_INDEX)})) ?
+        &_found_sid : $SID_INDEX ;
+}
+
+sub current_in_tie_sid_key {
+    my $self = shift ;
+    my $sid  = $self->is_job ;
+    my $key  = 0 ;
+    my %REFS = () ; # Reference counters to avoid infinite loops
+
+    # Retrieve the tiehash SID as a number (it is 0 if not a SID number)
+    while ($sid and $sid !~ /^\d+$/ and
+    (!defined($REFS{$sid}) or $REFS{$sid} < 2)) {
+        if ($sid =~ $MATCH_SID_TIED_KEY) {
+            # Extract SID from key
+            $sid = $1 ;
+
+        } else {
+            $REFS{$sid} ++ ; # Update reference counter to avoid infinite loops
+            # SID is a reference to another key or SID is invalid
+            if (defined($TIEHASH->{$sid})) {
+                if (defined($TIEHASH->{$self->get_sid_version_key($sid)})) {
+                    $key = $sid ;
+                    $sid = 0 ;
+                    last ;
+
+                } else {
+                    $sid = $TIEHASH->{$sid} ;
+                }
+
+            } else {
+                $sid = 0 ;
+            }
+        }
+    }
+
+    $key = $self->get_sid_key($sid) unless ($key);
+
+    # If not a numbered SID, we will retrieve from jobname
+    #&StatusDebug("Status SID for ".$self->is_job." has changed".
+    #    ($self->get_sid_index?" from ".$self->get_sid_index:"")." to $sid")
+    #    if ($sid and $self->get_sid_index != $sid);
+
+    return $key ;
+}
+
+sub compared_with_one_from_tiehash {
+    my $self = shift ;
+    my $job  = $self->is_job ;
+
+    # Retrieve the key of the object in the tied hash, needed to check version
+    my $sidkey = $self->current_in_tie_sid_key ;
+
+    if (defined($TIEHASH->{$sidkey})) {
+        #&StatusDebug("Checking $sidkey tied version");
+        # 1. The revision from tied hash can be a newer version
+        &TIMESTAT('STATUS-GET-COMPARED');
+        my $older = $self->is_older_than_tied($sidkey);
+        &TIMESTAT('STATUS-GET-COMPARED');
+        if ( $older ) {
+            &TIMESTAT('STATUS-GET-TIED');
+            &UPSTAT('HIT-TIED-STATUS');
+
+            # is_tied API must return 0 or a A2P::Status object
+            my $newself = $self->is_tied($sidkey);
+            if (defined($newself) and $newself) {
+                if ($newself != $self) {
+                    #&StatusDebug("Replacing $job by tied $sidkey (" .
+                    #    $newself->is_job . ") at rev. " .
+                    #    $newself->get_revision );
+
+                    # Don't forget to update it with current job name
+                    $newself->is_job($job);
+                    $self = $newself ;
+                }
+
+            } else {
+                &StatusDebug("Can't get $job Status from local file");
+            }
+            &TIMESTAT('STATUS-GET-TIED');
+
+        # 2. Our cached version is newer revision, we still got it
+        } else {
+            &UPSTAT('HIT-CACHED-STATUS');
+            #&StatusDebug("Keep cached '$job' status from memory at rev. "
+            #    . $self->get_revision);
+        }
+    }
+
+    return $self ;
+}
+
+sub is_done_and_timer_aged {
+    my $self = shift ;
+
+    # Only set the status is aged when parameter is set and status is DONE and
+    # the dirty bit 3 is not set (not synched in DB by a2p-status)
+    return 0 unless ( $STATUS_MAXAGE and $self->is_done
+        and ! $self->dirty_bit(3));
+
+    # Get the timer based age
+    my $age = $self->is_tied_timer ? &ms() - $self->is_tied_timer : 0 ;
+    &MAXSTAT("STATUS-TIMER-AGE",$age);
+    return $age > $STATUS_MAXAGE ? 1 : 0 ;
+}
+
+sub _born {
+    my $self = shift ;
+
+    # Set day status
+    my @time = localtime(time);
+    $self->{DAY} = ($time[5]%100 + 2000)*10000 + ($time[4]+1) *100 + $time[3] ;
+
+    # Set born time to the current millisecond from the epoch
+    $self->{BORN} = &ms() unless (defined($self->{BORN}) and $self->{BORN});
+}
+
+sub cached {
+    &TIMESTAT('STATUS-OBJECT-CACHED');
+    my $self = shift ;
+
+    # Update every important key in cache
+    map {
+        $CACHE->{$self->{$_}} = $self
+        } grep {
+            defined($self->{$_}) and $self->{$_}
+            } qw{
+                JOB JOBID AFP
+    };
+
+    # Check jobs reference in cache
+    my @jobs = defined($self->{JOBS}) ? @{$self->{JOBS}} : ();
+    map { $CACHE->{$_} = $self } grep { defined } @jobs ;
+
+    # Check SID usable in CACHE
+    SID_CACHE->{$self->get_sid_index} = $self
+        if $self->get_sid_index ;
+
+    # Set status is cached
+    $self->cache_timer ;
+    $self->is_cached(1);
+
+    &TIMESTAT('STATUS-OBJECT-CACHED');
+    1 ;
+}
+
+sub cache_timer {
+    # Update the cache timer
+    $_[0]->{TIMER} = &ms() ;
+}
+
+sub timer {
+    return $_[0]->{TIMER} || 0 ;
+}
+
+sub is_cached {
+    my $self = shift ;
+    return @_ ? ((defined($_[0]) and $_[0]) ?
+        $self->set_dirty_bit(10) : $self->unset_dirty_bit(10))
+        : $self->dirty_bit(10) ;
+}
+
+############## Dirty bits ############################ Dirty bits ##############
+# 1 -> Dirty cache: Cached status must be written to tied status hash
+# 2 -> Cache synched with DB, need to written new version in tied status hash
+# 3 -> Status is new or is not done in DB -> can't be removed from tied hash
+# 4 -> Cache and hash are synched: versioning can be updated in DB
+############## Dirty bits ############################ Dirty bits ##############
+sub dirty_bit {
+    my $self = shift ;
+    my $set  = shift || 1 ;
+    &StatusDebug("SET not defined") unless (defined($set));
+    if (@_) {
+        $self->{DIRTY} = 0 unless (exists($self->{DIRTY}));
+        vec($self->{DIRTY},$set,1) = (defined($_[0]) and $_[0])? 1 : 0 ;
+    }
+    return exists($self->{DIRTY}) ? vec($self->{DIRTY},$set,1) : 0 ;
+}
+
+sub set_dirty_bit {
+    # Set a bit with birty bit API
+    my $self = shift ;
+    my $bit  = shift || 1 ;
+    return $self->dirty_bit( $bit, 1 );
+}
+
+sub unset_dirty_bit {
+    # Unset a bit with birty bit API
+    my $self = shift ;
+    my $bit  = shift || 1 ;
+    return $self->dirty_bit( $bit, 0 );
+}
+
+sub get_cached_age {
+    return $_[0]->timer ? &ms() - $_[0]->timer : 0
+}
+
+sub check_cached_aged {
+    my $self = shift ;
+    # Check if our cache is too aged
+    if ($STATUS_CACHE_MAXAGE and defined($self)) {
+        my $age = $self->get_cached_age ;
+        if ( $age > $STATUS_CACHE_MAXAGE ) {
+            &MAXSTAT('STATUS-OBJECT-CACHE-AGE',$age);
+            &UPSTAT('CACHED-STATUS-OBJECT-CLEANED');
+            $self->remove_from_cache ;
+            $self = undef ;
+
+        } else {
+            # Set status is cached
+            $self->is_cached(1);
+        }
+    }
+    return $self ;
+}
+
+sub real_age {
+    return defined($_[0]->{BORN}) ? &ms() - $_[0]->{BORN} : 0 ;
+}
+
+sub StatusDebug {
+    return 1 unless $ADVANCED_DEBUGGING ;
+    my $add = "" ;
+    if ($0 !~ /^TEST/) {
+        if (defined($MESG{$_[0]})
+        and my ( $repeat, $timeout ) = @{$MESG{$_[0]}}) {
+            $MESG{$_[0]}->[0] ++ ;
+            return 1 unless ( &ms() >= $timeout );
+            $add = " ($repeat times)" unless ($repeat==1);
+
+        } else {
+            $MESG{$_[0]} = [ 1 ] ;
+        }
+    }
+    $MESG{$_[0]}->[1] = &ms(60) ; # Keep time out in one minute
+    my ($package, $filename, $line) = caller ;
+    &Debug( map { "at L.$line: " .$_ .$add } @_ );
+}
+
+sub get_lockid {
+    return defined($_[0]->{LOCKID}) ? $_[0]->{LOCKID} : $LOCKID ;
+}
+
+sub _format_info_to_keep {
+    my $this  = shift ;
+    my $key   = shift ;
+    my $value = shift ;
+
+    # Only handle the special case 'ABTERM'
+    return $value
+        unless ($key =~ /^ABTERM|ERRORS$/);
+
+    # Manage ABTERM case as growing array stripping ABTERM string
+    my $ref = ref($this->{$key}) =~ /^ARRAY/i ? $this->{$key} : [] ;
+    $value =~ s/^ABTERM[:]*\s*// ;
+    push @{$ref} , $value ;
+
+    return $ref ;
+}
+
+sub infos {
+    my $self  = shift ;
+    my $Infos = shift || {} ;
+
+    # Check $Infos is hash ref
+    return &Debug("Can't handle such information format ($Infos)") && 0
+        unless ( ref($Infos) =~ /^HASH/i );
+
+    my $tmpref = $self ;
+
+    # When called with a JID, we will have specific informations
+    if (defined($Infos->{JID})) {
+        # Update what we are for next informations
+        $self->{$Infos->{JID}} = {} unless (defined($self->{$Infos->{JID}}));
+        $tmpref = $self->{$Infos->{JID}} ;
+        $self->is_job($Infos->{JID});
+        delete $Infos->{JID} ;
+    }
+
+    while ( my ( $key, $info ) = each(%{$Infos}) ) {
+
+        $info = "" unless (defined($info));
+
+        # Strip not cesure chars and strip strings
+        $info =~ s|[^ .0-9A-Za-z%_/-]||g ;
+        $info =~ s/^\s+// ;
+        $info =~ s/\s+$// ;
+
+        $tmpref->{$key} = _format_info_to_keep($tmpref, $key, $info) ;
+    }
+
+    # Also auto update
+    $self->_auto_update ;
+
+    1 ;
+}
+
+sub _auto_update {
+    my $self = shift ;
+
+    # Check to update STATUS to ABTERM if ABTERM defined and STATUS is empty
+    $self->{STATUS} = 'ABTERM'
+        if (defined($self->{ABTERM}) and $self->{ABTERM}
+        # Control we are not trying to validate the job
+        and ( ref($self->{ABTERM}) !~ /^ARRAY/i
+            or $self->{ABTERM}->[$#{$self->{ABTERM}}] !~ /^validated/i )
+        and ( ! defined($self->{STATUS}) or ! $self->is_abterm ));
+
+    # Check job count
+    if (my ( $number ) = $self->{JOB} =~ /-(\d+)$/) {
+        # Update jobs index list with jid hash ref
+        $self->{JOBS}->[$number] = $self->is_job ;
+
+        $self->{NBJOBS} = $number
+            if (!defined($self->{NBJOBS}) or $self->{NBJOBS} < $number );
+    }
+}
+
+my $ko_status = qr/^ko|abterm$/i ;
+sub is_abterm {
+    return $_[0]->{STATUS} =~ $ko_status ;
+}
+
+my $done_status = qr/^DONE$/i ;
+sub is_done {
+    return $_[0]->{STATUS} =~ $done_status ;
+}
+
+sub is_filtered {
+    # Need to return 1 when not matching filters, filters are references
+    my $self = shift ;
+    my $job_filter = shift ;
+    my $day_filter = shift ;
+    my $status_filter = shift ;
+
+    return &Error("Unsupported filtering mode")
+        unless ( grep {
+            ref($_) =~ /^SCALAR/ } $day_filter, $job_filter, $status_filter
+            == 3 ) ;
+
+    # Filter on the day is done only
+    return 1
+        if ($$day_filter and ! defined($self->{'ABTERM'})
+            and $self->is_done and $self->{'DAY'} !~ /^$$day_filter$/);
+
+    # Filter on status
+    if ( $$status_filter ) {
+        my ( $not , $filter ) = $$status_filter =~ /^(!?)(.*)$/ ;
+        if ($filter = qr/^$filter$/i) {
+            return 1
+                if (($not and $self->{'STATUS'} =~ $filter) or
+                    (! $not and $self->{'STATUS'} !~ $filter));
+        }
+    }
+
+    return 0 unless ($$job_filter);
+
+    # We are filtering on a regex
+    my $filter = ref($$job_filter) =~ /^regex/i ? $$job_filter : qr/$$job_filter/i ;
+    return ( $self->{'AFP'} !~ $filter and $self->{'JOBID'} !~ $filter );
+}
+
+sub is_finished {
+    return ( $_[0]->{STEP} == 12 and $_[0]->step_status(12) eq 'o' ) ? 1 : 0 ;
+}
+
+sub is_job {
+    my $self = shift ;
+    $self->{JOB} = shift if (@_ and defined($_[0]));
+    return $self->{JOB} ;
+}
+
+sub is_tied_timer {
+    my $self = shift ;
+    $self->{TIED_TIMER} = shift if @_ ;
+    return $self->{TIED_TIMER} || 0 ;
+}
+
+sub is_tied {
+    # Have to update us against tied version
+    my $self = shift ;
+
+    my $sidkey = $_[0] || $self->get_sid_key(@_) ;
+    return 0 unless (exists($TIEHASH->{$sidkey}));
+
+    #&StatusDebug("Controling $sidkey from tied hash");
+    while ($TIEHASH->{$sidkey} =~ /^\d+$/) {
+        &Error("$sidkey sidkey is not status but reference to " .
+            $TIEHASH->{$sidkey});
+
+        my $rev_key = $self->get_sid_version_key($sidkey) ;
+        if (exists($TIEHASH->{$rev_key})) {
+            &Info("$rev_key revision key exists for $sidkey, removing it...");
+            delete $TIEHASH->{$rev_key} ;
+        }
+
+        my $newkey = $self->get_sid_key($TIEHASH->{$sidkey}) ;
+        unless (exists($TIEHASH->{$newkey})) {
+            delete $TIEHASH->{$sidkey} ;
+            return &Error("Bad reference to $sidkey");
+        }
+
+        $sidkey = $newkey ;
+    }
+
+    &TIMESTAT('IS-TIED-API');
+
+    # Work-around to a possible concurrencing case when key is updated in
+    # another process after a split job event, fix a a2p-status service crash
+    # TODO reproduce the case to found a better resolution
+    my $newself = $TIEHASH->{$sidkey} ;
+    {
+        my $tries = 10 ;
+        while ( $newself !~ /^\x04/ and $tries -- ) {
+            usleep $USLEEP ;
+            $newself = $TIEHASH->{$sidkey} ;
+        }
+        $SIG{'__DIE__'} = sub { undef $newself ; } ;
+        $newself = &thaw($newself) if ( $newself =~ /^\x04/ );
+    }
+
+    if (ref($newself) =~ /^A2P::Status/) {
+        #&StatusDebug("Retrieved $sidkey from tied hash");
+
+        # Control known SID
+        $self->set_sid_index( $self->db_sid )
+            unless ( $self->get_sid_index eq $self->db_sid );
+
+    } else {
+        &StatusDebug("Can't retrieved $sidkey as A2P::Status from tied hash");
+        $newself = 0 ;
+    }
+
+    &TIMESTAT('IS-TIED-API');
+
+    return $newself ;
+}
+
+sub remove_from_tied_hash {
+    # Still return if we don't have write access to tied file
+    return unless (_is_tie_writer);
+
+    my $self = shift ;
+    my $sid_key = $self->get_sid_key ;
+
+    # Remove from tied hash if really in tied hash
+    return unless (exists($TIEHASH->{$sid_key}));
+
+    &TIMESTAT('REMOVE-FROM-TIED');
+
+    &StatusDebug("Removing $sid_key from tied hash");
+    delete $TIEHASH->{$sid_key} ;
+    delete $TIEHASH->{$self->get_sid_version_key($sid_key)} ;
+
+    # Remove DB hash entry
+    $self->_DB_remove ;
+
+    # Remove any other reference to us, maybe chained references
+    my %remove_it = ( $sid_key => 1 );
+    my %not_ref_to = () ;
+
+    while ( my ( $key, $value ) = each(%{$TIEHASH}) ) {
+        # Skip well known not reference keys
+        next if ( $key =~ /_rev$/ );
+        my $next = $self->get_sid_key($value) ;
+        if ( $key =~ /^_SID_/ or $value =~ /\x04/
+        or exists($not_ref_to{$next}) or exists($not_ref_to{$key}) ) {
+            $not_ref_to{$key} = 1 ;
+            next ;
+        }
+
+        # Remove this key if it points to a well known reference to sid_key
+        if ( exists($remove_it{$next}) ) {
+            $remove_it{$key} = 1 ;
+
+        } else {
+            # Check chained reference
+            my %list = ( $key => 1 ) ;
+
+            while ( $value ) {
+                $value = $TIEHASH->{$next} || '' ;
+                if ( exists($remove_it{$next}) ) {
+                    map { $remove_it{$_} = 1 } keys(%list) ;
+                    last ;
+
+                } elsif ( $next =~ /^_SID_/ or $value =~ /\x04/
+                or exists($not_ref_to{$value}) ) {
+                    map { $not_ref_to{$_} = 1 } keys(%list) ;
+                    last ;
+                }
+
+                # Avoid looping infinitely on cross reference
+                last if (exists($list{$next}));
+                $list{$next} = 1 ;
+                $next = $self->get_sid_key($value) ;
+            }
+        }
+    }
+
+    # Now delete the found references, removing referenced key
+    delete $remove_it{$sid_key} ;
+    map { delete $TIEHASH->{$_} } keys(%remove_it) ;
+
+    &TIMESTAT('REMOVE-FROM-TIED');
+}
+
+sub remove_from_db {
+    my $self = shift ;
+    # Delete the row and eventually and eventually optimize the table
+    &job_status_delete($self->get_sid_index) if ($self->get_sid_index);
+}
+
+sub remove_from_cache {
+    my $self = shift ;
+
+    # Delete any used key pointing to ourself
+    map {
+        delete $CACHE->{$_}
+
+    } grep { $CACHE->{$_} == $self } keys(%{$CACHE}) ;
+
+    # Check any SID pointing to ourself
+    map {
+        delete SID_CACHE->{$_}
+
+    } grep { SID_CACHE->{$_} == $self } keys(%{&SID_CACHE}) ;
+
+    # Here cache should not have any reference to us, will die here
+    $self->is_cached(0);
+}
+
+sub clone {
+    return &thaw(&freeze($_[0])) ;
+}
+
+sub checked_in_db_timer {
+    my $self = shift ;
+    my @v = @_ ? ( $_[0] ? &ms() : 0 ) : () ;
+    return @v ? $self->_DB_this( 'CHK', 0, @v ) : $self->_DB_this( 'CHK', 0 );
+}
+
+sub check_update_in_db {
+    my $self = shift ;
+    my $sid  = $self->get_sid_index || $self->db_sid ;
+
+    unless ($sid) {
+        # Don't check if no SID available
+        &UPSTAT('STATUS-BAD-CHECK-UPDATE');
+        return 0 ;
+    }
+
+    # Don't recheck in DB too quickly, one time by minute is sufficient
+    return 0 if ($self->checked_in_db_timer > &ms(-60));
+
+    # Update checked in db timer to current time
+    $self->checked_in_db_timer(1);
+
+    my $updated = 0 ;
+    my @row = &is_job_status_updated($self->get_sid_index,$self->get_revision);
+    if (@row) {
+        # Update ourself
+        my @keys =qw(   LOCKID  JOBID  REV  TIMER  STEP
+                        STATE   BORN   DAY   AFP   STATUS  INFOS    );
+        foreach my $key (@keys) {
+            my $value = shift @row ;
+            unless (defined($value)) {
+                &StatusDebug("Bad update on $key value");
+                last ;
+            }
+            if ($key eq 'STATE') {
+                $self->{$key} = [ split(//,$value) ] ;
+
+            } else {
+                $self->{$key} = $value ;
+            }
+            $updated ++ ;
+        }
+        &StatusDebug("Updated $updated values from DB for job ".$self->{JOBID});
+        $self->set_dirty_bit ;
+    }
+    return $updated ;
+}
+
+sub _DB_name {
+    return $_[0]->{JOBID} ;
+}
+
+sub _DB_this {
+    my $self = shift ;
+    my $key  = shift or return 0 ;
+    my $def  = shift || 0 ;
+    my $job  = $self->_DB_name ;
+    $DB->{$job} = {} unless (exists($DB->{$job}));
+    $DB->{$job}->{$key} = shift if ( @_ and defined($_[0]) );
+    return exists($DB->{$job}->{$key}) ? $DB->{$job}->{$key} : $def ;
+}
+
+sub _DB_remove {
+    # Free memory to be called when no more needed. Should be called when the
+    # comparaison object is no more available in tied hash
+    my $self = shift ;
+    &UPSTAT('STATUS-DB-REMOVE');
+    &UPSTAT('STATUS-DB-REMOVE-AGE',$self->real_age);
+    delete $DB->{$self->_DB_name} if (exists($DB->{$self->_DB_name}));
+}
+
+sub db_revision {
+    my $self = shift ;
+    return @_ ? $self->_DB_this( 'REV', 0, @_ ) : $self->_DB_this( 'REV', 0 );
+}
+
+sub db_sid {
+    my $self = shift ;
+    return @_ ? $self->_DB_this( 'SID', 0, @_ ) : $self->_DB_this( 'SID', 0 );
+}
+
+sub db_checked {
+    my $self = shift ;
+    $self->_DB_this( 'SYNC_TIMER', 0, &ms() );
+    return $self->_DB_this( 'CHECKED', 0, $self->_DB_this( 'CHECKED', 0 )+1 );
+}
+
+sub checking_too_quickly {
+    return ( &ms() - $_[0]->_DB_this( 'SYNC_TIMER', 0 ) > 500 ) ? 0 : 1 ;
+}
+
+sub is_newer_than_db {
+    my $self = shift ;
+    return ( $self->db_revision < $self->get_revision ) ? 1 : 0 ;
+}
+
+sub sync_with_db {
+    my $self = shift ;
+    my $job  = $self->is_job ;
+
+    $! = 0 ;
+
+    # Get the current SID for that status
+    my $sid = $self->get_sid_index || $self->db_sid ;
+
+    # We update when we know DB rev is lower than current from cache
+    if ( $self->is_newer_than_db ) {
+        # Prepare row for update
+        my @row = ( $sid ) ;
+        push @row, map { defined($self->{$_}) ? $self->{$_} : "NULL" } qw{
+            LOCKID  JOBID  REV  TIMER  STEP
+            STATE  BORN    DAY    AFP  STATUS NBJOBS
+            };
+
+        # Add DestId list
+        my %destids = () ;
+        my @jobs = defined($self->{JOBS}) ?
+            grep { defined($_) } @{$self->{JOBS}} : () ;
+        map { $destids{uc($self->{$_}->{DESTID})} = 1 }
+            grep { defined($self->{$_}->{DESTID}) } @jobs ;
+        if (exists($destids{NULL})) { # Protect NULL DestID if defined
+            delete $destids{NULL} ;
+            $destids{'(NULL)'} = 1 ;
+        }
+        push @row, join(" ",keys(%destids)) || "none" ;
+
+        push @row, $self->{INFOS} || "" ;
+
+        # Check if update is done and we can continue the process
+        $sid = &job_status_update(@row) ;
+        unless ( $sid and ($sid == $self->db_sid or $self->db_sid($sid))) {
+            &Debug("Can't sync $job with @row to db row sid ".$sid);
+            return 0 ;
+        }
+
+        # Update revision
+        $self->db_revision($self->get_revision);
+
+    } elsif ( ! $self->dirty_bit(3) ) {
+        # Check if ABTERM status was updated by another service, this API do it
+        # at last one time by minute. We don't need to check GOOD status as they
+        # can't be updated to better status
+        &UPSTAT('STATUS-UPDATED-FROM-DB')
+            if ( $self->is_abterm and $self->check_update_in_db );
+    }
+
+    # Update our cache if gotten SID is different, check it as
+    # string as SIDs from standard thread are string by default (afp jobname)
+    if ( $self->get_sid_index ne $self->db_sid ) {
+        $self->set_sid_index( $self->db_sid );
+    }
+
+    # Keep statistics on control
+    &MAXSTAT('STATUS-RESYNCH-CHECKED',$self->db_checked);
+
+    # TODO Find why some time db_revision is greater than get_revision, maybe
+    # because a status update is done by a process on older status in its cache
+    unless ($self->db_revision and $self->db_revision >= $self->get_revision) {
+        &Debug("$job DB revision is " . $self->db_revision . " but ours is " .
+            $self->get_revision);
+        return 0 ;
+    }
+
+    return 1 ;
+}
+
+sub get_next_from_db {
+    my $self = shift ;
+
+    # Get the next row as a hash with column names as keys
+    my $row = &get_next_jobstatus( $self->get_sid_index, @_ ) ;
+
+    return 0 unless (ref($row) =~ /^HASH/);
+
+    # Invalidate ourself with empty JobID
+    $self->{JOBID} = '' ;
+    $self->is_job('INVALID JOB ROW');
+
+    # Update ourself to job in DB values
+    foreach my $key (keys(%{$row})) {
+        if ($key eq 'STATE') {
+            $self->{STATE} = [ split(//,$row->{STATE}) ] ;
+        } else {
+            $self->{$key}  = $row->{$key} ;
+        }
+    }
+
+    # Keep who we are now as valid job
+    $self->is_job($self->{JOBID}) if ($self->{JOBID});
+
+    1 ;
+}
+
+sub set_revision {
+    return ++ $_[0]->{REV}  ;
+}
+
+sub get_revision {
+    return $_[0]->{REV} ;
+}
+
+sub save_tied_versioning {
+    # We assume we can write to tied hash
+    my $self = shift ;
+    my $version = [ $self->get_revision, $self->get_lockid, $self->timer ] ;
+    #&StatusDebug("Saving ".$self->is_job." rev. ".$self->get_revision.
+    #    " versioning at key ".$self->get_sid_version_key(@_));
+    return $TIEHASH->{$self->get_sid_version_key(@_)} = &freeze($version);
+}
+
+sub is_tied_versioning {
+    my $self = shift ;
+    my $key = $self->get_sid_version_key(@_) ;
+      unless (defined($TIEHASH->{$key})) {
+        &StatusDebug("Versioning key $key is lost");
+        return ( 0, $LOCKID, 0 );
+    }
+    my @version = @{&thaw($TIEHASH->{$key})};
+    return @version ;
+}
+
+sub is_older_than_tied {
+    # When comparing with tied version, we should check first the timer when
+    # checking on the same LOCKID assuming this is the same service in the
+    # same place
+    my $self = shift ;
+    my ( $rev, $lockid, $timer ) = $self->is_tied_versioning(@_) ;
+
+    # Set ourself as dirty cached status if we are newer than tied version
+    $self->set_dirty_bit if ($self->get_revision > $rev);
+
+    #&StatusDebug("Comparing to @_ tied rev $rev, lockid $lockid, timer $timer");
+    return (( $LOCKID =~ /^$lockid$/ and $self->timer < $timer ) or
+        $self->get_revision < $rev ) ? $rev : 0 ;
+}
+
+sub status {
+    my $self = shift ;
+    return $self->{STATUS} = defined($self->{STATUS}) ? uc($self->{STATUS}) : "" ;
+}
+
+sub step_status {
+    my $self = shift ;
+
+    # Remove any undefined value, arise when starting a job
+    while (@_ and !defined($_[0])) { shift }
+
+    my $Step = shift || 0 ;
+
+    # Check step value to avoid updating job status on unused step
+    return 0 if ($Step < 0 or $Step > 12 );
+
+    if (@_) {
+        # Set step and later keep us in cache
+        my $State = shift || '.' ;
+
+        # Check we can update status
+        if ( $Step < 3 and $State =~ /^[._]$/ ) {
+            my $prev = $self->{STATE}->[$Step-1] || '0' ;
+            # Step starting, previous step must be 'o', '0', '_', '-' or 'A'
+            return 0 unless ( $prev =~ /^[0Ao_-]$/ );
+
+        } elsif ( $Step == 1 and $State eq 'o' ) {
+            # First call initializing a basic job status entry. This is
+            # done the first time in SpoolManager when processing AFP file
+            my $last = $self->{STATE}->[1] ; # Check job has still been started
+            my $restarted = (defined($last) and $last ne '_') ?
+                (exists($self->{FILE}) ? $self->{FILE} : $self->{AFP}) : '' ;
+
+            &Debug("Starting job " . $self->is_job .
+                ($restarted?"... ($restarted)":""));
+
+            # Initializes our birth and keep us in cache
+            $self->_set_defaults ;
+            $self->_born ;
+
+            # Check to remove old job status from previous start
+            if ($restarted) {
+                $self->{RESTARTED} = time ;
+                $self->{RESTART} = exists($self->{RESTART}) ?
+                    ++ $self->{RESTART} : 1 ;
+
+                # Set first step to number indicates a restart (with 0 -> >10)
+                $self->{STATE}->[0] = $self->{RESTART} > 9 ?
+                    0 : $self->{RESTART} ;
+
+                &Info("Seems to restart $restarted job".($self->{RESTART}>1?
+                    " (restart #".$self->{RESTART}.")":""));
+            }
+
+            # Set this status is new to being handled quickly
+            $self->set_is_new ;
+
+        } elsif ( $Step == 1 and $State eq 'V' ) {
+            # Specific to validation: force as new
+            $self->set_is_new ;
+            $State = 'o' ;
+        }
+
+        # Don't update STEP if still at higher step (protection)
+        $self->{STEP} = $Step unless ( $self->{STEP} > $Step );
+
+        # Update STATE checking if we can really update it
+        $self->{STATE}->[$Step] = $State
+            unless ( $self->{STATE}->[$Step] eq 'o'
+            or ( $self->{STATE}->[$Step] eq 'A' and $State ne 'o' ) );
+
+        # Now set cache is dirty
+        $self->set_dirty_bit ;
+    }
+
+    # Still return the current step
+    return $self->{STATE}->[$Step] eq '0' ? '_' : $self->{STATE}->[$Step] ;
+}
+
+sub set_is_new {
+    my $self = shift ;
+
+    # 1. Set the bit 3 to guaranty the status is not removed from tied hash
+    # Before it is in DB
+    $self->set_dirty_bit(3);
+
+    # 2. Use shared list of new status to inform a2p-status to handle this one
+    #    This is done in SpoolManager thread
+    my $shared_list = &SharedList( $self->get_lockid );
+    push @{$shared_list}, $self->get_sid_key ;
+    &FreeSharedList( $self->get_lockid );
+
+    # 3. Remove any stored Error or ABTERM
+    delete $self->{ABTERM} ;
+    delete $self->{ERRORS} ;
+
+    # 4. Remove any child error
+    if (exists($self->{JOBS}) and ref($self->{JOBS}) =~ /^ARRAY/i) {
+        map {
+            delete $self->{$_} ;
+
+        } grep {
+            defined($_) and $_ and exists($self->{$_})
+        } @{$self->{JOBS}} ;
+
+        delete $self->{JOBS} ;
+    }
+}
+
+sub save_tied {
+    my $self = shift ;
+
+    # Update our revision before trying to save it in tied hash
+    # But disable setting revision if requested for the case of just renaming
+    # status in tied hash
+    $self->set_revision() unless ( @_ and $_[0] =~ /^not a revision$/ );
+
+    # Check we are really tied
+    return 0 unless ( _is_tie_writer );
+
+    &TIMESTAT('SAVE-TIED');
+
+    # Reference is a number when we are knowing the SID index in DB
+    # otherwise it's the first inserted key in tied hash given by get_sid_key
+    my $sid_ref = $self->get_sid_index || $self->get_sid_key ;
+
+    # Update any important reference
+    my $sidkey_re = qr/^$sid_ref$/ ;
+    foreach my $ref (qw{ JOB AFP JOBID LINKEDAFP }) {
+        # Skip undefined and not set
+        next unless (defined($self->{$ref}) and $self->{$ref});
+        # Skip the SID key itself
+        next if ( $self->{$ref} =~ $sidkey_re );
+        # Skip if ref is still set
+        next if ( defined($TIEHASH->{$self->{$ref}}) and
+            $TIEHASH->{$self->{$ref}} =~ $sidkey_re );
+        # Then set reference
+        $TIEHASH->{$self->{$ref}} = $sid_ref ;
+        #&StatusDebug($self->{$ref}." replaced");
+        # Delete old versioning
+        if (exists($TIEHASH->{$self->{$ref}._rev_ext})) {
+            delete $TIEHASH->{$self->{$ref}._rev_ext};
+            #&StatusDebug($self->{$ref}._rev_ext. " deleted");
+        }
+    }
+
+    # Reset cached status
+    my $cached = $self->is_cached ;
+    $self->is_cached(0);
+    $self->unset_dirty_bit ;
+
+    # Update tied timer before freeze
+    $self->is_tied_timer(&ms());
+
+    # Prepare tied value as Storable freeze with DB information
+    my $freeze = &freeze($self) ;
+
+    # Keep statistics on stored length in tied hash
+    &MAXSTAT('MAX-TIED-STATUS-LENGTH',length($freeze));
+    &UPSTAT('SAVE-TIED');
+
+    # Save tied value as Storable freeze
+    my $sidkey = $self->get_sid_key ;
+    $TIEHASH->{$sidkey} = $freeze ;
+    $self->save_tied_versioning($sidkey) ;
+    &Warn("$sidkey SID versioning still lost")
+        unless (defined($TIEHASH->{$sidkey._rev_ext}));
+    #&StatusDebug($self->is_job." saved in tied for key $sidkey rev. " .
+    #    $self->get_revision);
+
+    # Reset cached status and others
+    $self->is_cached($cached);
+
+    &TIMESTAT('SAVE-TIED');
+    return $self ;
+}
+
+sub DESTROY {
+    # Remove debug message for minimal object
+    $MUSTQUIT and &StatusDebug("Freeing " . __PACKAGE__ .
+        " object memory " . $_[0]->get_sid_index . ":" . $_[0]->is_job .
+        ( defined($_[0]->{INITIAL}) ? " (" . $_[0]->{INITIAL} . ")" : "" ));
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
Index: /A2P/a2p/A2P/Syslog.pm
===================================================================
--- /A2P/a2p/A2P/Syslog.pm	(revision 3)
+++ /A2P/a2p/A2P/Syslog.pm	(revision 3)
@@ -0,0 +1,414 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+package A2P::Syslog;
+
+use strict ;
+use Socket ;
+use Errno qw( EINTR );
+use Time::HiRes qw( usleep gettimeofday tv_interval );
+use IO::Socket ;
+use MIME::Base64 ;
+use A2P::Globals ;
+use A2P::Com qw( GetCom comREQ comCOM comLOG TakeComLocking ReleaseComLocking );
+
+BEGIN {
+    use Exporter ();
+    our ( $VERSION , @ISA , @EXPORT , @EXPORT_OK , @TT );
+
+    $VERSION = sprintf "%s", q$Rev: 762 $ =~ /(\d[0-9.]+)\s+/ ;
+
+    @ISA = qw(Exporter);
+    @EXPORT = qw(   &Debug &Info &Notice &Error &Warn &Alert
+                    $loggertid &DirectLog &SetLogger &getBackLogs &AlertError
+                    &debugdev &NotImplemented &ResetDebug );
+    @EXPORT_OK= qw( &AttachZipToAlertError );
+
+    # Set timer ref to starting time
+    @TT = ( $^T , ( $^T * 1_000_000 ) % 1_000_000 ) unless @TT ;
+}
+our $VERSION ;
+
+our $loggertid  = 0 ;
+
+my $Logger      = 0 ;
+my $loggingname = $Progname ;
+
+# Shared timer to get syslog timestamps synchronized
+our @TT ;
+
+# Log backup
+my @BackLogs = () ;
+
+# Locking var to not get coflicts with coms
+my $lockfile = undef ;
+my $locked   = 0 ;
+
+# Syslog socket
+sub facility { 6 << 3 } # LOG_LPR Facility
+my $who = "" ;
+
+sub OpenSyslog {
+    my $toconnect = sockaddr_un($SYSLOG_PATH);
+    unless ( $toconnect ) {
+        warn "Can't locate $SYSLOG_PATH: $!\n" ;
+        return "" ;
+    }
+
+    unless ( socket( $SYSLOG, AF_UNIX, SOCK_STREAM, 0 )) {
+        warn "Can't open Syslog unix stream socket: $!\n" ;
+        return "" ;
+    }
+
+    if (!connect($SYSLOG,$toconnect)) {
+        unless (socket( $SYSLOG, AF_UNIX, SOCK_DGRAM, 0 )) {
+            warn "Can't open Syslog unix datagram socket: $!\n" ;
+            return "" ;
+        }
+        unless (connect($SYSLOG,$toconnect)) {
+            warn "Can't connect to Syslog unix datagram socket: $!\n" ;
+            return "" ;
+        }
+    }
+    return $loggingname . ( $LOCKID ? "-$LOCKID" : "" ) . "[$$]" ;
+}
+
+my %Level = ( 1 => 'alert', 3 => 'error' , 4 => 'warning' , 5 => 'notice' ,
+    6 => 'info' , 7 => 'debug' );
+
+sub DirectLog {
+
+    # First argument should be log level
+    # Second is an array of messages to log
+    # Third should be defined to get message up to parent
+    #   and content debugging info when required
+
+    return unless ( ref($_[1]) =~/^ARRAY/ );
+
+    my $level = shift ;
+    my $ref   = shift ;
+    $level = 6 unless ( defined($level) and $level );
+
+    my @hdr = $NO_SYSLOG_DEBUG ? () : ( &timestamp(), '>' );
+    push @hdr, "$Level{$level}: $loggingname:", @_ if @_ ;
+
+    # Reset error status for debugging output problems
+    $! = 0 ;
+
+    if ( $loggertid and $loggertid != $$ and $Logger and ! $ADVANCED_DEBUGGING ) {
+
+        close($SYSLOG) if (defined($SYSLOG));
+
+        # Keep who is logging when logging in file, and not at debug level
+        push @hdr, $Level{$level} . ":", $loggingname . "[$$]:"
+            if ( $LOGFILE_VS_SYSLOG and $level < 7 );
+
+        foreach my $logline ( @{$ref} ) {
+
+            my $comlog = &GetCom( comLOG , $level ,
+                 &KeepValidatedLog( \@hdr, $logline ));
+
+            unless($Logger->DoLog($comlog)) {
+                &debugdev("Log not sent on $Logger: $logline");
+
+                # Try to log directly by recall ourselves but avoiding this case
+                my $keep = $ADVANCED_DEBUGGING ;
+                $ADVANCED_DEBUGGING = 1 ;
+                &DirectLog( $level , $ref, @_ );
+                $ADVANCED_DEBUGGING = $keep ;
+            }
+        }
+
+    } elsif ( $LOGFILE_VS_SYSLOG or ( $level == 7 and $DEBUG_IN_FILE )) {
+
+        my $LOG ;
+
+        unshift @hdr, scalar(localtime), "[$$]:" ;
+        open( $LOG, '>>', $LOGFILENAME )
+            or warn "Can't open '$LOGFILENAME' for appending: $!\n", return 0 ;
+
+        &TakeComLocking($LOG);
+
+        my $test = 0 ;
+        map {
+            $test += print $LOG &KeepValidatedLog( \@hdr, $_ ), "\n"
+        } @{$ref} ;
+
+        $test == @{$ref} ? &UPSTAT('GOOD-LOGPRINT') : &UPSTAT('BAD-LOGPRINT');
+
+        &ReleaseComLocking($LOG);
+        close($LOG);
+
+    } else {
+
+        $who = &OpenSyslog();
+
+        if ($who) {
+            $level += facility ;
+            unshift @hdr, "<$level>$who:" ;
+
+            my $test = 0 ;
+            my $tempo = 0 ;
+            foreach my $line ( @{$ref} ) {
+                my $log = &KeepValidatedLog( \@hdr, $line );
+                my $sent = $! = 0 ;
+                while ( ! defined($sent = send( $SYSLOG , $log . "\0" , 0 ))) {
+                    # Retry only when we got a interrupted system call
+                    unless ( $! == EINTR ) {
+                        &debugdev("With line '$line'...",
+                            "Can't send to syslog '$log'");
+                        &debugdev("And errno[".int($!)."]= $!") if $! ;
+                        last ;
+                    }
+                    usleep $USLEEP ;
+                    $! = 0 ;
+                }
+
+                $test ++ ;
+                $tempo += $sent ;
+            }
+
+            $test == @{$ref} ? &UPSTAT('GOOD-SYSLOGPRINT') : &UPSTAT('BAD-SYSLOGPRINT');
+
+            close($SYSLOG);
+        }
+    }
+
+    $! = 0 ;
+}
+
+sub KeepValidatedLog {
+    my $timeref = shift ;
+    my $logline = shift ;
+
+    $logline =~ s/[^ -~]/ /go ;
+
+    # Keep ref to log if requested
+    if ( $MAX_BACKLOG and ! $KEEP_DYNAMIC_JOB_LOG ) {
+        shift @BackLogs until ( @BackLogs < $MAX_BACKLOG );
+        push @BackLogs, [ @{$timeref} , $logline ] ;
+    }
+
+    local $" = ' ' ;
+    return ( @{$timeref} ? "@{$timeref} " : "" ) . $logline ;
+}
+
+sub getBackLogs {
+    # Re-assemble logs ref
+    return map { join('', @{$_}) } @BackLogs ;
+}
+
+sub timestamp {
+    return "" if ( $NO_SYSLOG_DEBUG and ! $MAX_BACKLOG and ! $STDOUT_DEBUG);
+    # Keep timer in the current minute
+    my @tt = &gettimeofday() ;
+    return sprintf("%.8d",
+        (( $tt[0] - $TT[0] ) * 1_000_000 + ( $tt[1] - $TT[1] )) % 60_000_000 );
+}
+
+#############################################################################
+##                 Standard system logging functions                       ##
+#############################################################################
+my $LastCount = 0 ;
+my $LastDebugMessage = "" ;
+
+sub SetLogger {
+    $Logger      = shift ;
+    $loggingname = $0 ;
+}
+
+sub debugdev {
+    my $time = localtime(time);
+    print STDERR
+        map { $time, &timestamp, ": $Progname\[$$]: [DEV]: ", $_, "\n" } @_ ;
+}
+
+sub NotImplemented {
+    my ( $package, $filename, $line, $sub ) = caller ;
+    &DirectLog( 5 , [ "Need implementation".(@_?" of '@_'":"")." in $filename" ],
+         $package.", ".$sub."(), L.".$line.":");
+}
+
+my %DebugMods = () ;
+my $ReversedDebugModList = 0 ;
+sub ResetDebug {
+    my $last = $ReversedDebugModList ;
+    $ReversedDebugModList = $NODEBUG_MOD_LIST =~ /^(!)/ ;
+    $NODEBUG_MOD_LIST =~ s/[!]//g ;
+    %DebugMods = map { $_ => 1 } split(/[,;\s]+/,$NODEBUG_MOD_LIST) ;
+    return if ($NO_SYSLOG_DEBUG);
+    &DirectLog( 7 , [ "Switching NODEBUG_MOD_LIST comportement to " .
+        ($ReversedDebugModList?"":"not ") . "debug on ".join(" ",keys(%DebugMods)) ] )
+        unless ( $ReversedDebugModList == $last );
+}
+
+my $lastdebug = [ &gettimeofday() ] ;
+sub Debug {
+    return &debugdev(@_) if ( $STDOUT_DEBUG );
+    return if ( $NO_SYSLOG_DEBUG and ( $KEEP_DYNAMIC_JOB_LOG or ! $MAX_BACKLOG ));
+
+    my ($package, $filename, $line) = caller ;
+
+    return if ($ReversedDebugModList ^ defined($DebugMods{$package}));
+
+    my @sub = caller(1);
+    @sub = caller(2) if ( defined($sub[3]) and $sub[3] =~ /Debug$/ );
+    $sub[3] = "(none)" unless (@sub > 3);
+    my ( $sub ) = $sub[3] =~ /^.*::([^:]*)$/ ;
+
+    return if ( $sub and $NODEBUG_SUB_LIST =~ /$sub/ );
+    if ( $#_ or $_[0] ne $LastDebugMessage or &tv_interval($lastdebug) > 1 ) {
+        if ($NO_SYSLOG_DEBUG) {
+            &KeepValidatedLog( [ &timestamp() ],
+                "Last message repeated $LastCount times")
+                    if $LastCount ;
+            map {
+                &KeepValidatedLog( [ &timestamp(), "$package,".
+                ( $sub ? "$sub," : ""), "L.$line:" ], $_ )
+            } @_ ;
+
+        } else {
+            &DirectLog( 7 , [ " last message repeated $LastCount times" ] , "..." )
+                if $LastCount ;
+            &DirectLog( 7 , \@_, "$package,".( $sub ? "$sub," : ""), "L.$line:" );
+        }
+        $LastDebugMessage = defined($_[$#_]) ? $_[$#_] : "" ;
+        $LastCount = 0 if $LastCount ;
+        $lastdebug = [ &gettimeofday() ] ;
+
+    } else {
+        $LastCount ++ ;
+    }
+}
+
+sub Info {
+    &DirectLog( 6 , \@_ );
+}
+
+sub Notice {
+    &DirectLog( 5 , \@_ );
+}
+
+sub Error {
+   if ($NO_SYSLOG_DEBUG and ! $ADVANCED_DEBUGGING) {
+        &DirectLog( 3 , \@_ );
+
+    } else {
+        my ( $package, $filename, $line, $sub ) = caller ;
+        $filename =~ m|([^/]+)$| ;
+        &DirectLog( 3   , \@_ , "$package, L.$line:" );
+        &DirectLog( 7 , \@_ , "ERROR: $package, L.$line:" );
+        ($package, $filename, $line, $sub) = caller(1);
+        return 0 unless (defined($filename) and defined($line) and defined($sub) and $sub);
+        $filename =~ m|([^/]+)$| ;
+        &DirectLog( 7 , \@_ , "ERROR: $1, $sub, L.$line:" );
+        ($package, $filename, $line, $sub) = caller(2);
+        return 0 unless (defined($filename) and defined($line) and defined($sub) and $sub);
+        $filename =~ m|([^/]+)$| ;
+        &DirectLog( 7 , \@_ , "ERROR: $1, $sub, L.$line:" );
+    }
+    0 ;
+}
+
+sub Warn {
+    &DirectLog( 4 , \@_ );
+}
+
+sub Alert {
+    return &Warn("Alert called without message") unless ( @_ and $_[0] );
+    if ( -x $MAIL_BIN ) {
+        if ( $ALERT_MAILS ) {
+            open(*MAIL,"|$MAIL_BIN $ALERT_MAILS")
+                or &Warn("Can't open mailer program: $!");
+            print MAIL "Subject: [$Progname;$LOCKID] $_[0]\n";
+            close(MAIL);
+            &Info("Alert sent to '$ALERT_MAILS'");
+        }
+        &AlertError(@_) if $ERROR_MAILS ;
+
+    } else {
+        &Warn("Can't open mailer program as it is not launchable");
+    }
+    # Reduce alert to syslog to only give the alert title
+    &DirectLog( 1 , [ $_[0] ] );
+}
+
+my $zipfile = "" ;
+sub AttachZipToAlertError {
+    $zipfile = shift ;
+}
+
+sub AlertError {
+    return &Warn("Alert called without message") unless ( @_ and $_[0] );
+    if ( -x $MAIL_BIN ) {
+        if ( $ERROR_MAILS ) {
+
+            open(*MAIL,"|$MAIL_BIN $ERROR_MAILS")
+                or return &Warn("Can't open mailer program: $!");
+
+            my $boundary = "_----------=_" . int(time) . $$ ;
+
+            print MAIL "Subject: [$Progname;$LOCKID] $_[0]\n" ;
+
+            print MAIL "Content-Transfer-Encoding: binary
+Content-Type: multipart/mixed; boundary=$boundary
+MIME-Version: 1.0
+X-Mailer: $loggingname v$VERSION (", __PACKAGE__, " rev $VERSION)
+
+This is a multi-part message in MIME format.
+
+--$boundary
+
+"               if ( $zipfile and -e $zipfile );
+
+            # Anyway insert alert content
+            map { print MAIL $_ , "\n" } @_ ;
+
+            if ( $zipfile and -e $zipfile ) {
+                my $buf ;
+                my ( $zipname ) = $zipfile =~ m|^.*/([^/]+)$| ;
+                if ( open(*ZIP, '<', $zipfile)) {
+                    binmode(ZIP);
+                    print MAIL "
+--$boundary
+Content-Transfer-Encoding: base64
+Content-Type: application/zip; name='$zipname'\n\n" ;
+                    while (read(ZIP,$buf,60*57)) {
+                        print MAIL encode_base64($buf);
+                    }
+                }
+                $zipfile = "" ;
+                print MAIL "\n\n--$boundary--\n\n" ;
+            }
+            close(MAIL);
+            &Info("Alert with errors sent to '$ERROR_MAILS'");
+            &Debug("Mail sent");
+        }
+
+    } else {
+        &Warn("Can't open mailer program as it is not launchable");
+    }
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded") unless ( $0 =~ /cgi/ );
+
+1;
Index: /A2P/a2p/A2P/Thread.pm
===================================================================
--- /A2P/a2p/A2P/Thread.pm	(revision 3)
+++ /A2P/a2p/A2P/Thread.pm	(revision 3)
@@ -0,0 +1,1489 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+package A2P::Thread;
+
+use strict ;
+use Socket ;
+use Errno qw(:POSIX);
+use Fcntl ':flock' ;
+use IO::Socket ;
+use Time::HiRes qw( usleep gettimeofday tv_interval ) ;
+use POSIX qw(:signal_h :sys_wait_h setsid) ;
+use A2P::Globals ;
+use A2P::Syslog  ;
+use A2P::threads ;
+use A2P::threads qw( threadSleep reduceSleep ) ;
+use A2P::Signal  ;
+use A2P::Signal  qw( LogSigMessage ) ;
+use A2P::Globals qw( UpdateSharedEnv ) ;
+use A2P::Com qw( comREQ comCOM comJOB comUPD comDONE comINF comXML comTEST
+                 IsCom GetCom  TakeComLocking ReleaseComLocking GetTmpFile );
+use A2P::JobStatus 'a2pjobstate' ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 1399 $ =~ /(\d[0-9.]+)\s+/ ;
+}
+our $VERSION ;
+
+# Hash used for communications
+my %ReadBuffer = () ;
+my %lockfh     = () ;
+my %SocketProc = () ;
+my %BUFLEN     = () ;
+my $THIS ;
+
+sub new {
+    my $class = shift ;
+
+    &Debug("new $class v$VERSION");
+
+    $class =~ /^A2P::(.*)$/ ;
+    my $self = {
+        KIND       =>  $1,
+        NAME       =>  $Progname . '-' . $1 ,
+        SIGTERM    =>  0,
+        SIGKILL    =>  0,
+        TOPING     =>  0,
+        LOGGER     =>  0,
+        BUSY       =>  [ 0, "" ],
+        DO_QUIT    =>  0,
+        DO_STAT    =>  [ &gettimeofday() ],
+        CanPING    =>  [ &gettimeofday() ],
+        HAVE_STATS =>  0,
+        STATS      =>  [],
+        DONTSLEEP  =>  0,
+        URGENTCOM  =>  0,
+        COMBUFFER  =>  [],
+        JOB        =>  ""
+    };
+
+    return bless $self , $class ;
+}
+
+sub init {
+    my $self = shift ;
+    &Debug("new A2P::Thread is " . $self->getName);
+
+    return $self->ThreadError("1, '$self->{KIND}' is not a valid thread kind")
+        unless defined($SonKind{$self->{KIND}}) ;
+
+    socketpair( $self->{SON}, $self->{DADDY}, AF_UNIX, SOCK_STREAM, PF_UNSPEC )
+        or return $self->ThreadError("2, Can't open socket pair for " .
+        $self->{KIND} . " thread: $!");
+
+    bless $self->{SON}   , "IO::Socket" ;
+    bless $self->{DADDY} , "IO::Socket" ;
+
+    &Debug($self->getName . " object is ready");
+    1 ;
+}
+
+our $AbortMessages ;
+
+sub defautABTERMError {
+    return () ;
+}
+
+sub ABTERM {
+    my $self = shift ;
+    my ( $package, $filename, $line ) = caller ;
+    my $Err  = $_[0] =~ /^\d+$/ ? shift : $line ;
+
+    @AbortTime = &gettimeofday();
+
+    my @ERR = $self->defautABTERMError() ;
+
+    push @ERR, (defined($AbortMessages) and defined($AbortMessages->{$Err}))?
+        ( $Err < 100 ?
+            $AbortMessages->{$Err}
+            :
+            sprintf( $AbortMessages->{$Err} , @_ )
+        )
+        : @_ ;
+
+    &Error( @ERR );
+
+    # Return information to JobManager is JOB defined and not JobManager
+    map { $self->Return( $self->{JOB} => &GetCom( comINF, 'ABTERM', $_ )) } @ERR
+        if (defined($self->{JOB}) and ! $self->is('JobManager'));
+
+    map { &a2pjobstate( $self->{JOB}, $self->{STEP}, 'A',
+            { ABTERM => $_ } ) } @ERR
+        if (defined($self->{JOB}) and defined($self->{STEP}));
+
+    &UPSTAT('JOB-ABTERM');
+    0 ;
+}
+
+sub getBusyReq {
+    # Cosmetic function to return debugging info for later debug
+    my $self = shift ;
+    my @business = @{$self->{BUSY}};
+    shift @business ;
+    return "@business" ;
+}
+
+sub setBusy  {
+    my $self = shift ;
+    @{$self->{BUSY}} = @_ ;
+    &UPSTAT('SET-BUSY-SON') if ( $_[0] );
+}
+
+sub isBusyBy {
+    my $self = shift ;
+    # {BUSY} is initialized to [ 0 , "" ] at object creation
+    if ( @_ ) {
+        return $self->{BUSY}->[0] == $_[0] ;
+    } else {
+        return $self->{BUSY}->[0];
+    }
+}
+
+sub setReady {
+    &UPSTAT('SET-READY-SON');
+    $_[0]->setBusy( 0, "" );
+}
+
+sub self_TEST {
+    my $self = shift ;
+    $do_test = 0 ;
+
+    our @TT ;
+    $STATS{'RUNNING'} = sprintf("%.01fs", &tv_interval(\@TT) - $^T);
+
+    # Output current memorized dynamic statistics
+    my @stats = grep { $STATS{$_} } sort(keys(%STATS)) ;
+    my $tag = $maintid ? "-$maintid" : "" ;
+    if (@stats) {
+        open LOG, ">>", "/tmp/$Progname$tag-selftest.log"
+            or return &Error("Can't open log file in /tmp for self-test: $!");
+
+        # Don't check anything as this is not critical
+        flock(LOG, LOCK_EX);
+
+        foreach my $stat
+            ( map { sprintf("%50s %s", $_, $STATS{$_}) } @stats ) {
+            print LOG $stat, "\n" ;
+        }
+        flock(LOG, LOCK_UN);
+        close(LOG);
+    }
+
+    # Output current memorized log lines
+    my @logs = &getBackLogs();
+    if ( @logs ) {
+        open LOG, ">>", "/tmp/$Progname$tag-selfdebug.log"
+            or return &Error("Can't open log file in /tmp for self-debug: $!");
+
+        flock(LOG, LOCK_EX);
+
+        foreach my $debug ( @logs ) {
+            print LOG $debug, "\n" ;
+        }
+        flock(LOG, LOCK_UN);
+        close(LOG);
+    }
+
+    # Output other things
+    foreach my $Array qw( REQUESTS_ARRAY ) {
+        if (defined($self->{$Array})) {
+            my @Array = @{$self->{$Array}} ;
+            if (@Array) {
+                my $ii = 0 ;
+                my $li = "[%0" . scalar(@{$self->{$Array}}) . "d]: " ;
+
+                open LOG, ">>", "/tmp/$Progname$tag-self$Array.log"
+                    or return &Error("Can't open log file in /tmp for " . $Array
+                    . " array: $!");
+
+                flock(LOG, LOCK_EX);
+
+                foreach my $val ( @Array ) {
+                    $val = ref($val) =~ /^ARRAY/i ? join('',@{$val}) : $val ;
+                    print LOG $Array, sprintf($li,$ii++), $val, "\n" ;
+                }
+                flock(LOG, LOCK_UN);
+                close(LOG);
+            }
+        }
+    }
+}
+
+sub Delete {
+    my $self = shift ;
+    &Debug("Deleting T$self->{TID} thread from sons list")
+        unless (defined($self->{TOCLEAN}));
+    $sons{$self->{TID}} = 0 ;
+    delete $sons{$self->{TID}} ;
+    undef $self
+}
+
+sub ThisError {
+    my ( $package, $filename, $line ) = caller ;
+    $filename =~ m|([^/]+)$| ;
+    &Error($_[0]->getName . ": from $1, L.$line: " . $_[1]);
+    0 ;
+}
+
+sub commonloopdebug {
+    my $self = shift ;
+    &Debug("Current BUFLEN:", map { "$_ -> $BUFLEN{$_}" } keys(%BUFLEN));
+}
+
+sub loopdebug ;
+*loopdebug = \&commonloopdebug ;
+
+sub ThreadError {
+    $_[0]->{ERROR} = $_[1] ;
+    0 ;
+}
+
+sub setToClean {
+    $_[0]->{TOCLEAN} = 1 ;
+}
+
+sub SwitchLogger {
+    # Only called from parent
+    return 0 if ( $_[0]->{LOGGER} == $_[1] or ! $_[0]->{TID} );
+    &Debug("Switching logger to T$_[1] for " . $_[0]->getName);
+    $_[0]->{LOGGER} = $_[1] ;
+    $_[0]->AskThread( _INIT , "<logger>$_[1]</logger>" );
+}
+
+sub getName {
+    return $_[0]->{NAME} ;
+}
+
+sub getKind {
+    return $_[0]->{KIND} ;
+}
+
+sub is {
+    return grep { $_[0]->getKind() eq $_ } @_ ;
+}
+
+sub isForked {
+    return defined($_[0]->{FORKED}) ? 1 : 0 ;
+}
+
+sub isAlive {
+    return 0 unless ( $_[0]->{TID} );
+    my $test = 0 ;
+    $test ++ if (kill 0 , $_[0]->{TID});
+    # TODO Contrôler errno p 371 linux PT
+    &Debug( $_[0]->getName . ( $test ? " seems alive" : " seems dead" ) );
+    return $test ;
+}
+
+sub isToCheck {
+    return 0 if (defined($_[0]->{QUITTING}));
+    # A thread is to check if it has been check more than 15 seconds ago
+    return $_[0]->LastCheck() > 15 ? $_[0]->CanPing() : 0 ;
+}
+
+sub KeepStats {
+    my $self = shift ;
+    return unless ( $self->{HAVE_STATS} and $KEEP_STATS and -d $STATS_FOLDER );
+
+    if (@_) {
+        my @time = localtime ;
+        push @{$self->{STATS}}, [
+            sprintf('%4d%02d%02d', 1900+$time[5], $time[4]+1, $time[3]),
+            sprintf('%02d%02d%02d', $time[2], $time[1], $time[0])
+            , $self->myStats(\@_) ];
+    }
+
+    # Only keep stat after at least 1 second has passed, and there's some
+    # But keep output stats if we are quitting
+    return unless ( @{$self->{STATS}}
+        and ($self->{DO_QUIT} or &tv_interval($self->{DO_STAT}) > 1));
+
+    my %Locked = () ;
+    my $File ;
+    foreach my $Stat ( @{$self->{STATS}} ) {
+
+        # Compute filename
+        my $statfile = $self->getName() . '-' . $Stat->[0] ;
+
+        unless ( $Locked{$statfile} ) {
+
+            open $File, ">>$STATS_FOLDER/$statfile"
+                or return $self->ThreadError("Can't open stats file '" .
+                    $statfile . "': $!");
+
+            # Try exclusive lock
+            my $locked = flock($File, LOCK_EX);
+
+            unless ($locked) {
+                close($File);
+                return $self->ThreadError("Can't lock stats file '" .
+                    $statfile . "': $!");
+            }
+
+            if ( defined($self->{STATHEADERS}) and @{$self->{STATHEADERS}} ) {
+
+                # Force again headers output after a restart, in case they
+                # have changed
+                print $File join(';', @{$self->{STATHEADERS}}), "\n"
+                    or return $self->ThreadError("Can't output in file '" .
+                        $statfile . "': $!");
+
+                @{$self->{STATHEADERS}} = () ;
+            }
+
+            $Locked{$statfile} = $File ;
+        }
+
+        $File = $Locked{$statfile} ;
+        print $File join(';', @{$Stat}), "\n"
+            or return $self->ThreadError("Can't output in statfile '" .
+                $statfile . "': $!");
+    }
+
+    $self->{STATS} = [ ] ;
+
+    # Unlock and close stat files
+    map { flock($Locked{$_}, LOCK_UN) and close($Locked{$_}) } keys(%Locked);
+
+    # Reset stats timer
+    $self->{DO_STAT} = [ &gettimeofday() ];
+}
+
+sub LastCheck {
+    return defined($_[0]->{CHECKED}) ? &tv_interval($_[0]->{CHECKED}) : 100 ;
+}
+
+sub Check {
+    $_[0]->{TOPING} ++ ;
+    # A thread is really busy if it has not say any thing since 60 seconds
+    # (see isToCheck())
+    &Info($_[0]->getName . " thread seems busy since " .
+      sprintf("%.2f s",$_[0]->{TOPING}))
+        unless ( $_[0]->{TOPING} and $_[0]->{TOPING} % 4 );
+    $_[0]->{CHECKED} = [ &gettimeofday() ];
+    $_[0]->{CanPING} = [ &gettimeofday() ];
+}
+
+sub Ping {
+    $_[0]->AskThread( PING ) if ( $_[0]->{TOPING} and $_[0]->CanPing() );
+}
+
+sub GotPing {
+    $_[0]->{CHECKED} = [ &gettimeofday() ];
+    $_[0]->{TOPING} -- ;
+    $_[0]->{CanPING} = [ &gettimeofday() ];
+}
+
+sub CanPing {
+    # We can repeat a ping only if last ping was done more than 5 seconds ago
+    return 0 unless (defined($_[0]->{CanPING}));
+
+    if (&tv_interval($_[0]->{CanPING}) > 5) {
+        $_[0]->{CanPING} = [ &gettimeofday() ] ;
+        return 1 ;
+    }
+    0 ;
+}
+
+sub SendSigTerm {
+    # Send SIGTERM one time after at least 5 seconds
+    my $self = shift;
+    my $since = $self->StoppingSince();
+    return 0 unless ( $since > 5 and $since < 30 and ! $self->{SIGTERM} );
+    &Debug("Killing " . $self->getName . " with SIGTERM");
+    kill 15, $self->{TID} ;
+    return ++ $self->{SIGTERM} ;
+}
+
+sub SendSigKill {
+    # Send SIGKILL one time after at least 30 seconds
+    my $self = shift;
+    return 0 if ( $self->{SIGKILL} or $self->StoppingSince() < 30 );
+    &Debug("Killing " . $self->getName . " with SIGKILL");
+    kill 9, $self->{TID} ;
+    return ++ $self->{SIGKILL} ;
+}
+
+################################################################################
+##          Fork code                                                         ##
+################################################################################
+sub Fork {
+    my $self = shift;
+
+    # Security: Only one fork call can be done by created Thread object
+    return undef if ($self->isForked());
+
+    # Classical way to fork
+    $self->{TID} = fork ;
+
+    # Return to parent early if not forked
+    return undef unless (defined($self->{TID}));
+
+    $self->{FORKED} = [ &gettimeofday() ];
+
+    # Clean SYSLOG socket
+    if (defined($SYSLOG)) {
+        shutdown($SYSLOG,2);
+        $SYSLOG = undef ;
+        &Debug("SYSLOG socket is reset");
+    }
+
+    # Return to parent
+    if ( $self->{TID} ) {
+        #============ In parent =============
+        &Debug("Parent-to-child link is " . $self->{SON} );
+        push @PIPE , $self->{SON} ;
+
+        # Set the filename for COM locking
+        $SocketProc{$self->{SON}} = "$maintid-" . $self->getKind()
+            if $COM_LOCKING ;
+
+        # Can define logger socket for parent
+        &SetLogger( $self ) if ($self->is('Logger'));
+
+        # Update object name as it is used in logging messages
+        $self->{NAME} .= '[' . $self->{TID} . ']' ;
+
+        # Return to caller in parent
+        return $self->{TID} ;
+    }
+
+    #=== In child, we won't leave this object member ===
+
+    # Clean error status
+    $? = 0 ;
+    $! = 0 ;
+
+    # Clean open COM locking sockets and communications hashes
+    if ( $COM_LOCKING ) {
+        map { close($lockfh{$_}) } keys(%lockfh);
+        %SocketProc = () ;
+        %lockfh     = () ;
+    }
+    %ReadBuffer = () ;
+    %BUFLEN     = () ;
+
+    # Clear stats
+    map { $STATS{$_} = 0 } keys(%STATS) ;
+
+    # Update immedialty signal handling,
+    # Keep in mind these signal handlers won't be called as object member
+    $SIG{'USR1'} = \&mySigUSR1 ;
+    $SIG{'ALRM'} = \&mySigALRM ;
+    $SIG{'TERM'} = \&mySigTERM ;
+    $SIG{'QUIT'} = \&mySigTERM ;
+    $SIG{'HUP'}  = \&mySigHUP  ;
+    $SIG{'ABRT'} = \&mySigTERM ;
+
+    # Update child process name
+    $0        = $self->getName ; # Update process name with 'ps' command
+    $Progname = $self->getName ; # For logging
+
+    # Reduce priority as parent must be the one with the greater priority
+    my $priority = getpriority( 0, $$ );
+    if ( $priority < 15 ) {
+        # Increase our priority
+        setpriority 0, 0, $priority + 5
+            or &Warn("Can't update priority: $!");
+    }
+
+    $self->ThreadInitEarly();
+
+    &Debug("Child " . $self->getName . " is starting...");
+    &Debug("Child-to-parent link is " . $self->{DADDY} );
+    push @PIPE , $self->{DADDY} ;
+
+    # Cleaning this process from previously created objects
+    map {
+        if ( $_ != $$ ) {
+            &Debug("Cleaning unused T$_ cloned object during fork");
+            $sons{$_}->setToClean() ; # Just to avoid checking from DESTROY sub
+            $sons{$_}->Delete();
+        }
+    } keys(%sons);
+    &Debug("Memory cleaned");
+
+    &Debug("Starting " . $self->getName . " T$$");
+
+    $self->ThreadInit();
+
+    my $Ret = $self->ForkedLoop ;
+
+    $loggertid = 0 ; # Force to log directly
+    &LogSigMessage();
+
+    &Debug($self->getName . " ended ($MUSTQUIT;$!;$?;$@)");
+    &Debug("Forced to quit ($MUSTQUIT)") if $MUSTQUIT ;
+
+    $self->Answer( QUIT );
+
+    $self->KeepStats();
+
+    $self->DoBeforeQuit();
+
+    exit $Ret ;
+}
+
+my @bad_answer = () ;
+my @KeepRequest = () ;
+sub ForkedLoop {
+    my $self = $THIS = shift ;
+    my $ErrCount = 0 ;
+    my $request ;
+    my $LoopTiming = [ &gettimeofday() ];
+    my $PendingStatus = [ &gettimeofday() ];
+    my $LoopCount  = 0 ;
+    my $SleepFactor = 1 ;
+    $! = 0 ;
+
+    while ( ! ( $MUSTQUIT or $self->{DO_QUIT} ) ) {
+        &TIMESTAT('ForkedLoop');
+
+        &LogSigMessage();
+
+        # Check to commit any pending job status at last each minute
+        if (&tv_interval($PendingStatus) > 60) {
+            &a2pjobstate ;
+            $PendingStatus = [ &gettimeofday() ];
+        }
+
+        &UPSTAT('LOOPS');
+        $self->{DONTSLEEP} ? &reduceSleep('no stats') : &threadSleep() ;
+
+        # Just to flush buffer
+        $self->PrintSock($self->{DADDY});
+
+        $self->KeepStats();
+
+        # Test thread sub, can be useful while debugging
+        $self->self_TEST() if $do_test ;
+
+        my $max = $COM_BURST ;
+        while ( $max-- and
+            (defined( $request = $self->GetRequest($self->{DADDY})))) {
+
+            last if ( $MUSTQUIT or $self->{DO_QUIT} );
+
+            chomp $request ;
+
+            my @Req = &IsCom( comREQ , $request );
+
+            if ( @Req == 2 ) {
+
+                if ( $Req[0] == QUIT ) { # Do I have to quit
+                    &Debug("Notified to QUIT by parent");
+                    $self->{DO_QUIT} = 1 ;
+
+                } elsif ( $Req[0] == PING ) { # Do I have to ping
+                    $self->Answer( PING );
+                    &Debug("PING");
+
+                } elsif ( $Req[0] == _INIT ) { # ENV update
+                    $self->Answer( _INIT );
+
+                    if ( $Req[1] =~ m|^<init>\s*(\$ENV{\w+}\s*=.*)</init>$|i ) {
+                        if ( $self->{clientrequest} ) {
+                            # SECURITY issue:
+                            # Only Listener is concerned: no external init
+                            # accepted for now
+                            $self->CloseClient( $self->{clientrequest}, 1,
+                                "INIT is not supported from other application");
+
+                        } else {
+                            &Debug("Do INIT: $1");
+                            eval $1 ;
+                        }
+
+                    } elsif ( $Req[1] =~ m|^<init>CAN_UPDATE_NOW</init>$|i ) {
+                        # Update shared vars with ENV definition
+                        &UpdateSharedEnv ;
+                        # Reset Debug comportement
+                        &ResetDebug() ;
+                        $self->InitUpdated();
+
+                    } elsif ( $Req[1] =~ m|^<logger>(\d+)</logger>$|i ) {
+
+                        if ( $1 == $$ ) {
+                            &Debug("Approuved as logger");
+
+                        } elsif ( $self->is('Logger') ) {
+                            &Debug("Revoked as logger thread");
+                            # We should quit as we are no more used for service
+                            $self->{DO_QUIT} = 1 ;
+
+                        } else {
+                            &Debug("My logger is T$1") if $1 ;
+                            $loggertid = $1 ;
+                        }
+
+                    } else {
+                        $self->ThisError("Not able to evaluate '" . $Req[1] .
+                            "' as ENV update");
+                        $ErrCount ++ ;
+                    }
+
+                } elsif ( $Req[0] == TODO ) {
+                    &Debug("Got 'TODO' COM: '$Req[1]'") if $ADVANCED_DEBUGGING ;
+                    $ErrCount ++ unless $self->Do( \$Req[1] );
+
+                    # Called to do our job to we should sleep less next time
+                    &reduceSleep();
+
+                } else {
+                    $self->ThisError("[DEV] Can't decide request " .
+                        (defined($means{$request})?$means{$request}:$request));
+                    $ErrCount ++ ;
+                }
+
+            # TODO Test me with also $Req[0] == _UPDATE
+            } elsif ( @Req = &IsCom( comUPD , $request ) ) {
+                if ( $Req[1] =~ m|^<update>(\w+)=(["'])?(.*)\2</update>$|i ) {
+                    my ( $var , $value ) = ( $1 , $3 );
+                    if (defined($1) and defined($3)) {
+                        if ( grep { /$var/ } @SHARED ) {
+                            my $apos = $value =~ /^\d+$/ ? '' : '"' ;
+                            eval '$' . $var . '=' . $apos . $value . $apos ;
+                            # For important thread initialization
+                            $self->InitUpdated();
+                            &UPSTAT($var.'_DIRECT_UPDATE');
+
+                        } else {
+                            $self->ThisError("Not authorized to update '" . $var
+                                . "' to '$value'");
+                            &UPSTAT('UNAUTH_DIRECT_UPDATE');
+                            $ErrCount ++ ;
+                        }
+
+                    } else {
+                        $self->ThisError("Bad direct update request '$Req[1]'");
+                        &UPSTAT('BAD_DIRECT_UPDATE');
+                        $ErrCount ++ ;
+                    }
+
+                } else {
+                    $self->ThisError("Bad formated update request '$Req[1]'");
+                    &UPSTAT('BADFORMAT_UPDATE');
+                    $ErrCount ++ ;
+                }
+
+            } elsif (  @Req = &IsCom( comCOM , $request ) ) {
+                if ( $Req[1] == comDONE ) {
+                    &UPSTAT('GETCOMDONE');
+
+                    &Debug("Received comDONE from parent")
+                        if $ADVANCED_DEBUGGING ;
+                    $self->ResetRemoteBufSize($self->{DADDY});
+
+                } else {
+                    $self->ThisError("[DEV] Can't handle request '$request'");
+                    $ErrCount ++ ;
+                }
+
+            # Handle XML request
+            } elsif ( @Req = &IsCom( comXML , $request ) ) {
+                &Debug("Got an XML request");
+
+                # Check we have XML API and call it
+                if (UNIVERSAL::can( $self , 'XML' )) {
+                    $self->XML($request);
+
+                } else {
+                    $self->ThisError("[DEV] Not expected to handle '" . $request
+                        . "' XML request");
+                    $ErrCount ++ ;
+                }
+
+            } else {
+                if ( $request =~ /^[<]/ ) {
+                    my $ref ;
+                    &UPSTAT('COM-CHECK-FRAGMENT');
+                    # Control this com is still not handled
+                    if (($ref) = grep { $_->[0] eq $request } @bad_answer ) {
+                        # Don't keep too much time
+                        next if (++ $ref->[1] < 100);
+
+                    } else {
+                        # Will try to reassemble a fragmented com
+                        push @bad_answer, [ $request, 0 ] ;
+                        $max ++ ;
+                        next ;
+                    }
+
+                } elsif (@bad_answer) {
+                    # Try to assemble and reinject immediatly
+                    my $try = shift @bad_answer ;
+                    my $com = $try->[0] . $request ;
+                    &Info("Trying reassembled com: $com");
+                    push @KeepRequest, $com ;
+                    &UPSTAT('COM-REASSEMBLED');
+                    $max ++ ;
+                    next ;
+                }
+
+                # This only critical if not in Logger
+                if ($self->getKind() eq 'Logger') {
+                    &Warn("Critical error on " . $self->getName);
+                } else {
+                    &Alert("Critical error on " . $self->getName);
+                }
+                $self->ThisError("[DEV] Can't interpret request '$request'");
+                $ErrCount ++ ;
+            }
+
+        }# Loop COM_BURST
+
+        # Check parent is alive
+        unless ( kill 0, $maintid ) {
+            # TODO Contrôler errno p 371 de linux pt
+            $loggertid = 0 ;
+            &Warn("Quitting as parent seems dead");
+            $MUSTQUIT = 1 ;
+        }
+
+        { # Rating the do loop
+            no integer ;
+            $LoopCount += 100 ;
+            my $int = &tv_interval($LoopTiming);
+            if ( $int >= 1 ) {
+                $LoopCount = 0 ;
+                $LoopTiming = [ &gettimeofday() ];
+                &MAXSTAT('DOLOOP-RATE',int($LoopCount/$int)/100);
+            }
+        }
+
+        if ( $ADVANCED_DEBUGGING ) {
+            &Debug("Loop rate is " . $STATS{'DOLOOP-RATE'} );
+            $self->loopdebug();
+        }
+
+        &TIMESTAT('ForkedLoop');
+    }# Loop to read queue
+
+    undef $THIS ;
+
+    &Debug("$ErrCount counted errors") if $ErrCount ;
+    return $ErrCount ? 1 : 0 ;
+}
+################################################################################
+##          End Fork code                                                     ##
+################################################################################
+
+sub ThreadInit {
+    1 ; # Nothing to do by default
+}
+
+sub ThreadInitEarly {
+    # Directly link Log answers to parent (defined in Syslog.pm)
+    &SetLogger( $_[0] );
+
+    # This member must be overrided in Logger Object
+}
+
+sub InitUpdated {
+    1 ; # Nothing to do by default
+}
+
+sub GetRequest {
+    my $self     = shift ;
+    my $Requests = shift ;
+
+    # Check if we got a fragmented not safe request
+    return shift @KeepRequest if @KeepRequest ;
+
+    return ( $MUSTQUIT or $self->{DO_QUIT} )? 1 : $self->ReadSock($Requests) ;
+}
+
+sub Do {
+    my $self = shift ;
+    my $ref  = shift ;
+    &Debug("Got to do '$$ref'");
+}
+
+sub DoBeforeQuit {
+    1 ; # Nothing to do by default
+}
+
+sub mySigUSR1 {
+    push @SigDebug, "SIGUSR1 received in " . __PACKAGE__ ;
+    $do_test ++ ;
+}
+
+sub mySigALRM {
+    return unless ($SCAN_SPOOL);
+    $do_file ++ if ( $do_file < $MAXTASK and $SCAN_SPOOL );
+    push @SigDebug, "SIGALRM received (do_file=$do_file) in " . __PACKAGE__ ;
+}
+
+sub mySigTERM {
+    my $ref = $_[0] eq 'ABRT' ? \@SigWarn : \@SigDebug ;
+    push @{$ref}, "SIG$_[0] received in " . __PACKAGE__ ;
+    $MUSTQUIT ++ ;
+    $NO_SYSLOG_DEBUG = 0 if $SERVICE_DEBUG ;
+}
+
+sub mySigHUP {
+    push @SigDebug, "SIGHUP received in " . __PACKAGE__ ;
+}
+
+sub mySigPIPE {
+    my ($package, $filename, $line) = caller();
+    push @SigDebug , "SIG$_[0] received at L. $line in $package: $! $?" ;
+    $MUSTQUIT ++ unless ( grep { defined($_) } @PIPE );
+}
+
+sub myStats {
+    my $self = shift ;
+    return @{$_[0]} ;
+}
+
+sub AskThread {
+    my $self   = shift ;
+    my $Asking = $self->{SON} ;
+
+    if (@_ > 10) {
+        return &Error("[DEV] Too large argument for AskThread: @_");
+    }
+
+    my $msg = &GetCom( comREQ , @_ );
+    {
+        my $len = length($msg);
+        &MAXSTAT('REQUEST-LEN', $len);
+        if ( $len < 50 ) {       &UPSTAT('REQUEST-LEN-000-049');
+        } elsif ( $len < 100 ) { &UPSTAT('REQUEST-LEN-050-099');
+        } elsif ( $len < 200 ) { &UPSTAT('REQUEST-LEN-100-199');
+        } elsif ( $len < 500 ) { &UPSTAT('REQUEST-LEN-200-499');
+        } elsif ( $len < 1000) { &UPSTAT('REQUEST-LEN-500-999');
+        } else {
+            &UPSTAT('REQUEST-LEN-1000+');
+            if ( $len > 9999 ) {
+                open LOG, ">" . &GetTmpFile("$Progname-lastbigreq.log")
+                    or return &Error("Can't open big req log file in TMP: $!");
+                print LOG $msg, "\n" ;
+                close(LOG);
+            }
+        }
+    }
+
+    &UPSTAT("SENDLINES-".$self->{KIND});
+
+    return $self->PrintSock( $Asking, $msg ) ;
+}
+
+sub AnswerDone {
+    $_[0]->Answer( &GetCom( comJOB , $_[1] , &GetCom( comDONE )));
+}
+
+sub AnswerComDone {
+    my $self   = shift ;
+    my $socket = $self->{SON} ;
+    $socket = $self->{DADDY} unless ( $$ == $maintid );
+    $self->{URGENTCOM} = 1 ;
+    if (defined($socket)) {
+        $! = 0 ;
+        $self->ThisError("Can't answer comDONE".(($!)?": $!":""))
+            unless ($self->PrintSock($socket,&GetCom( comCOM , $$ , comDONE )));
+
+    } else {
+        $self->ThisError("Can't answer comDONE: socket not available");
+    }
+    $self->{URGENTCOM} = 0 ;
+}
+
+sub Return {
+    my $self = shift ;
+    $self->Answer( &GetCom( comREQ , JobManager => &GetCom( comJOB , @_ )));
+}
+
+sub Answer {
+    my $self    = shift ;
+    my $Answers = $self->{DADDY} ;
+    return &UPSTAT('Answer-ERROR') unless ( defined($Answers) and @_ );
+
+    my $msg = &GetCom( comCOM, $$ => ( @_ > 1 ? &GetCom( comJOB, @_ ): $_[0] ));
+
+    {
+        my $len = length($msg);
+        &MAXSTAT('Answer-MAXLEN',$len);
+        if ( $len < 50 ) {       &UPSTAT('Answer-LEN-000-049');
+        } elsif ( $len < 100 ) { &UPSTAT('Answer-LEN-050-099');
+        } elsif ( $len < 200 ) { &UPSTAT('Answer-LEN-100-199');
+        } elsif ( $len < 500 ) { &UPSTAT('Answer-LEN-200-499');
+        } elsif ( $len < 1000) { &UPSTAT('Answer-LEN-500-999');
+        } else {                 &UPSTAT('Answer-LEN-1000+'); }
+        if ( $len > $MAX_BUFFER_SIZE - 4096 ) {
+            &UPSTAT("BADCOM-LEN-$len");
+            open LOG, ">>" . &GetTmpFile("$Progname-$maintid-badcom.log")
+                or return &Error("Can't open badcom log file in TMP: $!");
+            print LOG $msg, "\n" ;
+            close(LOG);
+            return &Error("Won't send too long ($len) com");
+        }
+    }
+
+    unless ($self->PrintSock($Answers, $msg )) {
+        &Debug("Answer not sent, ".__PACKAGE__.", l. ".__LINE__." ($!-$?-$@)");
+        return 0 ;
+    }
+}
+
+sub Request {
+    my $self = shift;
+    return unless @_ ;
+    $self->Answer( &GetCom( comREQ , @_ ) );
+}
+
+sub getAnswers { # Should only be used by parent thread
+    my $self = shift;
+    my $max  = $COM_BURST ;
+    my @mesg = () ;
+
+    while ( $max-- and my $msg = $self->ReadSock($self->{SON}) ) {
+        next unless (defined($msg));
+        chomp $msg ;
+        next unless $msg ; # Skip empty lines
+        {
+            my $len = length($msg);
+            &MAXSTAT('ANSWER-MAXLEN',$len);
+            if ( $len < 50 ) {       &UPSTAT('ANSWER-LEN-000-049');
+            } elsif ( $len < 100 ) { &UPSTAT('ANSWER-LEN-050-099');
+            } elsif ( $len < 200 ) { &UPSTAT('ANSWER-LEN-100-199');
+            } elsif ( $len < 500 ) { &UPSTAT('ANSWER-LEN-200-499');
+            } elsif ( $len < 1000) { &UPSTAT('ANSWER-LEN-500-999');
+            } else {                 &UPSTAT('ANSWER-LEN-1000+'); }
+        }
+        push @mesg, $msg ;
+    }
+
+    # Update read line counter
+    &UPSTAT("READLINES-".$self->{KIND},scalar(@mesg));
+
+    return @mesg ;
+}
+
+sub AskToStop {
+    my $self = shift;
+
+    return 1 if ($self->StoppingSince());
+
+    $self->{QUITTING} = [ &gettimeofday() ];
+
+    while ( $self->AskThread( QUIT ) < 0 ) {
+
+        usleep $USLEEP ;
+
+        unless ($self->StoppingSince() < 0.5) {
+            &Info("Can't ask to quit: $! - $? - $@");
+            return 0;
+        }
+    }
+
+    1 ;
+}
+
+sub AskInit {
+    return $_[0]->ThreadError("1, can't ask to init '$_[1]'")
+        unless ($_[0]->AskThread( _INIT , "<init>$_[1]</init>" ));
+    $_[0]->{_INIT} ++ ;
+}
+
+sub GotInit {
+    $_[0]->{_INIT} -- ;
+    &Debug("Thread " . $_[0]->getName . " ENV updated")
+        unless ( $_[0]->{_INIT} );
+}
+
+sub StoppingSince {
+    return defined($_[0]->{QUITTING}) ? &tv_interval( $_[0]->{QUITTING} ) : 0 ;
+}
+
+sub DoLog {
+    my $self = shift ;
+    &UPSTAT('DOLOG');
+    my $good = 0 ;
+
+    if ( $$ == $maintid ) {
+        if ($self->is('Logger')) {
+            $good = $self->PrintSock($self->{SON}, &GetCom( comREQ, TODO, @_ ));
+
+        } else {
+            &debugdev("Not expected to handle '@_' here");
+            &UPSTAT('DOLOG-ERROR');
+        }
+
+    } else {
+        $good = $self->PrintSock($self->{DADDY}, &GetCom( comCOM , $$ ,  @_ ));
+    }
+
+    unless ($good) {
+        &UPSTAT('BAD-DOLOG');
+        return 0 ;
+    }
+}
+
+sub END {
+    my $self = $THIS;
+
+    if (defined($self)) {
+        &Debug("Thread T$$ was " . ($self->{DO_QUIT}?"quitting ":"") .
+            "on job $self->{JOB}")
+                if $self->{JOB} ;
+
+        # Return any recent Sig message when thread seems aborting unexpectedly
+        if ( $$ != $maintid and ! $self->{DO_QUIT} and ! $self->is('JobManager')
+            and $self->{JOB} and defined($self->{DADDY})
+            and (@SigWarn or @SigInfo))
+        {
+            # Try to advertize JobManager
+            map { $self->Return(
+                $self->{JOB} => &GetCom( comINF, Warning => $_ )) } @SigWarn ;
+            map { $self->Return(
+                $self->{JOB} => &GetCom( comINF, Info => $_ )) } @SigInfo ;
+            map { $self->Return(
+                $self->{JOB} => &GetCom( comINF, Debug => $_ )) } @SigDebug ;
+            $self->Return( $self->{JOB} , 255 );
+            $self->AnswerDone( $self->{JOB} );
+            $self->{JOB} = "" ;
+        }
+
+        # Update loggertid to log directly
+        &LogSigMessage();
+    }
+}
+
+sub PreDESTROY {}
+
+sub DESTROY {
+    my $self = shift;
+
+    $self->PreDESTROY();
+
+    if (!defined($self->{TOCLEAN})) {
+        # Return any recent Sig message when thread seems aborting unexpectedly
+        if ( $$ != $maintid and ! $self->{DO_QUIT} and ! $self->is('JobManager')
+            and ( $self->{JOB} or !defined($self->{DADDY}) )
+            and ( @SigWarn or @SigInfo ) )
+        {
+            &Alert("T$$ seems aborted abnormally".(defined($self->{DADDY})?"":
+                " with socket to parent lost"), @SigWarn, @SigInfo, @SigDebug );
+        }
+
+        # Update loggertid to log directly
+        &LogSigMessage();
+
+        # Debug age
+        &Debug(sprintf("%s Age = %.2f s", $self->{NAME},
+            &tv_interval( $self->{FORKED} )))
+                if ($self->isForked());
+
+        # Must kill forked thread if alive
+        if ( $self->isForked() and $self->isAlive() ) {
+            &Debug("Killing thread object $self->{NAME}");
+            kill 9, $self->{TID} ;
+        }
+
+        if (defined($self->{ERROR})) {
+            &Error("Thread type object $self->{NAME} destroyed with error #" .
+                $self->{ERROR});
+        } else {
+            &Debug("Thread object $self->{NAME} destroyed");
+        }
+
+        &Debug("Thread object $self->{NAME} status: $! - $? - $@")
+            if ( $! or $? or $@ );
+    }
+
+    map {
+        shutdown( $_, 2 )
+    } grep {
+        defined($_) and (! $self->{TID} or $$ == $maintid)
+    }
+        ( $self->{SON} , $self->{DADDY} );
+
+    &Debug(__PACKAGE__." T".($self->{TID}?$self->{TID}:$$)." memory cleaned");
+}
+
+############################### Dedicated socket communication members
+sub ReadSock {
+    &TIMESTAT('ReadSock');
+    my $self = shift ;
+    my $Socket = shift ;
+
+    my $fh = $lockfh{$Socket};
+    @{$ReadBuffer{$Socket}} = () unless (defined($ReadBuffer{$Socket}));
+
+    my $locked = 0 ;
+    my $size = 0 ;
+    my ( $bigeventcheck , $bigevent ) = ( 1 , 0 );
+    my ( $sysreadbuffer, $buffer ) = ( "" , "" );
+
+    $Socket->blocking(0);
+
+    $locked = &TakeComLocking($fh) if ($COM_LOCKING and $maintid);
+
+    $! = 0 ;
+
+    while (defined($size+=sysread($Socket, $sysreadbuffer, $MAX_BUFFER_SIZE))) {
+
+        last unless $size ;
+
+        $buffer .= $sysreadbuffer ;
+
+        # bigread-event: Handle case we have fullfil our read buffer, we must
+        # complete with next read so loop to next sysread
+        # Test modulo bigeventcheck to handle the case we fullfil more than once
+        last unless ( $size % $MAX_BUFFER_SIZE == $bigeventcheck );
+
+        &UPSTAT('BIGREAD-EVENT'.&SelfStatId($self,'full'));
+        $bigeventcheck = ++ $bigevent ;
+        $sysreadbuffer = "" ;
+    }
+
+    # Don't stats BUSY ressource
+    &UPSTAT('errno-'.int($!)."-$!") if ( $! and $! != 11 );
+
+    if ($buffer) {
+        my @lines = split(/\n/,$buffer);
+        my $count = scalar(@lines) ;
+        my $check = comTEST ;
+        # Check buffer could contain a comTEST event as test could involve
+        # performance issue
+        if ( $buffer =~ /$check/ ) {
+            my @test ;
+            # Check really now there's a formated comTEST
+            @lines = grep {
+                @test = &IsCom( comCOM , $_ );
+                $test[1] !~ /^$check$/
+                } @lines ;
+            if (@lines != $count ){
+                &UPSTAT('GET-COMTEST'.&SelfStatId($self));
+                &Debug("Received comTEST for " . $self->getName)
+                    if $ADVANCED_DEBUGGING ;
+                $self->AnswerComDone ;
+            }
+        }
+
+        # Keep lines in socket dedicated buffer
+        push @{$ReadBuffer{$Socket}} , @lines ;
+
+        # Keep some monitoring scalar
+        $STATS{'READ-LINES-DUMP'.&SelfStatId($self)} = "@lines" if $bigevent ;
+        &MAXSTAT('MAX-READ-LINES',scalar(@lines));
+        &MAXSTAT('MAX-READSIZE',$size);
+        &MAXSTAT('MAX-READBUFFER-LINES',scalar(@{$ReadBuffer{$Socket}}));
+    }
+
+    &UPSTAT('READSOCK-ERR-'.$!.&SelfStatId($self,'full'))
+        unless (defined($size));
+
+    &ReleaseComLocking($fh) if ( $locked );
+
+    &TIMESTAT('ReadSock');
+    return shift @{$ReadBuffer{$Socket}} ;
+}
+
+sub PrintSock {
+    my $self = shift ;
+    &UPSTAT('PRINTSOCK-CALL'.&SelfStatId($self));
+    my $Socket = shift ;
+    my $locked = 0 ;
+
+    # Return printing immediatly unless we should use com locking
+    unless ($COM_LOCKING and $maintid) {
+        # maintid is always set after perl is loaded
+        my $Ret = &RealPrintSock( $self, $Socket, @_ );
+        return $Ret ;
+    }
+
+    # Only open lockfile one time by process, and keep it opened
+    my $fh = $lockfh{$Socket} ;
+    unless (defined($fh)) {
+        $SocketProc{$Socket} = "$maintid-" . $self->getKind()
+            unless (defined($SocketProc{$Socket}));
+        my $lockfile = &GetTmpFile("$SocketProc{$Socket}.comlock");
+
+        if (defined($lockfh{$lockfile})) {
+            $lockfh{$Socket} = $lockfh{$lockfile} ;
+
+        } else {
+            unless ( -e $lockfile ) {
+                open $lockfh{$Socket} , ">" . $lockfile ;
+                close($lockfh{$Socket});
+            }
+            open $lockfh{$Socket} , "+<" . $lockfile
+                or delete $lockfh{$Socket},
+                return &debugdev("Can't open '$lockfile' com lock file: $!");
+            $lockfh{$lockfile} = $lockfh{$Socket} ;
+        }
+        $fh = $lockfh{$Socket} ;
+    }
+
+    $locked = &TakeComLocking($fh);
+
+    my $Ret = &RealPrintSock( $self, $Socket, @_ );
+
+    &ReleaseComLocking($fh) if ( $locked );
+
+    #&TIMESTAT('PrintSock');
+    return $Ret ;
+}
+
+sub Bufferize {
+    my $self = shift ;
+    my $Socket = shift ;
+    return [] unless (defined($Socket));
+    my $ref = shift ;
+
+    my $bufname = 'BUFFER-LINES'.&SelfStatId($self) ;
+    &MAXSTAT($bufname."-LINES",scalar(@{$self->{COMBUFFER}}));
+
+    # Bufferize
+    if ($self->{URGENTCOM}) {
+        unshift @{$self->{COMBUFFER}} , @{$ref} ;
+        return $self->{COMBUFFER} ;
+
+    } else {
+        push @{$self->{COMBUFFER}} , @{$ref} ;
+    }
+
+    # Test if remote buffer may be full to return empty array ref
+    return &RemoteIsFull($self,$Socket) ? [] : $self->{COMBUFFER} ;
+}
+
+sub RemoteIsFull {
+    my $self = shift ;
+    return 0 if ($self->{URGENTCOM});
+    my $Socket = shift ;
+    return 0 unless (defined($Socket));
+    my $ref = shift ;
+    local $" = '' ;
+    my $len = defined($ref) ? length("@{$ref}") : 0 ;
+    $len += length(@{$self->{COMBUFFER}}[0]) + 1
+        if ( defined($self->{COMBUFFER}) and @{$self->{COMBUFFER}} );
+    $len += $BUFLEN{$Socket}  + 4096 ;
+    if ( $len > $MAX_BUFFER_SIZE ) {
+        &UPSTAT('REMOTE-FULL-BUFFER-CHECK'.&SelfStatId($self,'full'));
+        return $len ;
+    }
+    return 0 ;
+}
+
+sub RemoteBufSizeUpdate {
+    my $self = shift ;
+    my $Socket = shift ;
+    $BUFLEN{$Socket} += shift ;
+    $STATS{'CUR-BUFFER-CONTROL'.&SelfStatId($self,'full')} = $BUFLEN{$Socket} ;
+}
+
+my %ComTest = () ;
+sub ResetRemoteBufSize {
+    my $self = shift ;
+    my $Socket = shift ;
+    $Socket = $self->{SON} unless (defined($Socket));
+    $BUFLEN{$Socket} = 0 ;
+    delete $ComTest{$Socket} if (defined($ComTest{$Socket}));
+}
+
+sub SelfStatId {
+    my $self = shift ;
+    return "" unless ( defined($self) and $$ == $maintid );
+    return '-' . ( @_ ? $self->getName : $self->getKind );
+}
+
+sub RetryLater {
+    my $self   = shift ;
+    my $buffer = shift ;
+    my $print  = shift ;
+    &UPSTAT('SOCK-RETRYLATER-EVENT'.&SelfStatId($self));
+
+    unshift @{$buffer}, @{$print} ;
+
+    return scalar(@{$print});
+}
+
+sub RealPrintSock {
+    &TIMESTAT('RealPrintSock');
+    my $self = shift ;
+    my $Socket = shift ;
+
+    # Below syntax is right but involve a bug
+    #my $urgent = (defined($self) and exists($self->{URGENTCOM})) ?
+    #    $self->{URGENTCOM} : 0 ;
+
+    # This one is the last from a2p v1.020 without the bug
+    my $urgent = defined($self) and $self->{URGENTCOM} ;
+
+    my $count ;
+    local $" = "\n" ;
+    my ( $total , $lines , $test ) = ( 0 , 0 , 0 );
+    my @print = () ;
+
+    $! = 0 ;
+
+    my $buffer = &Bufferize( $self, $Socket , \@_ );
+
+    while ( @{$buffer} or &RemoteIsFull( $self, $Socket ) ) {
+
+        if ( @{$buffer} ) {
+            $lines ++;
+            my $line = shift @{$buffer} ;
+            push @print , $line ;
+        }
+
+        $test = &RemoteIsFull( $self, $Socket, \@print );
+        #$test = $self->{URGENTCOM} unless ( $test or ! defined($self));
+
+        if ( ! @{$buffer} or $test or $urgent ) {
+            my $tries = 0 ;
+
+            # Add comTEST to COM
+            if ( $test ) {
+                if (! defined($ComTest{$Socket})
+                or &tv_interval($ComTest{$Socket}) >= 1) {
+                    # Send again comTEST after 1 second
+                    local $" = "' '" ;
+                    my $comtest = &GetCom( comCOM, $$ , comTEST );
+                    $ComTest{$Socket} = [ &gettimeofday() ] ;
+                    &UPSTAT('ADD-COMTEST-EVENT'.&SelfStatId($self));
+                    if ( $test >= $MAX_BUFFER_SIZE ) {
+                        &UPSTAT('KEEP-COMTEST-EVENT'.&SelfStatId($self));
+                        if (@print and ! $urgent) {
+                            my $print = pop @print ;
+                            $lines -- ;
+                            unshift @{$buffer}, $print ;
+                            &debugdev("Retry later '$print'" . ( @print ?
+                                " keeping '@print'":"") .
+                                " to be sure to not fullfill remote buffer" .
+                                " with '$comtest'")
+                                if ( $ADVANCED_DEBUGGING );
+                        }
+
+                    } elsif ( $ADVANCED_DEBUGGING ) {
+                        &debugdev("Sending '$comtest'" .
+                            (@print?" added to '@print'":""));
+                    }
+                    # Add comtest to print list
+                    push @print, $comtest ;
+
+                } elsif (@print) {
+                    &UPSTAT('SOCK-RECENT-COMTEST-EVENT'.&SelfStatId($self));
+                    # Last comTEST was sent recently, we should better directly
+                    # keep the com and retry it later
+                    $lines -= &RetryLater($self,$buffer,\@print);
+                    $total = -1 unless ($total);
+                    last ;
+
+                } else {
+                    &UPSTAT('SOCK-RECENT-COMTEST-EVENT'.&SelfStatId($self));
+                    # Remote buffer can be full and we have recently sent a
+                    # comTEST and there's nothing to send, so just leave
+                    $total = -1 ;
+                    last ;
+                }
+            }
+
+            # Wait when socket is busy
+            my $print = "@print" . $" ;
+            while (!defined($count = syswrite($Socket, $print))
+            and $! == EAGAIN ) {
+                &UPSTAT('BUSY-SOCKET-EVENT'.&SelfStatId($self));
+                last if ( $tries ++ > 1000 );
+                usleep $USLEEP ;
+                last if $MUSTQUIT ;
+                &Debug("$Socket socket seems busy with errno: $!")
+                    unless ( $tries % 20 );
+            }
+
+            if ( $tries ) {
+                local $" = ' ' ;
+                &MAXSTAT('CHARSOCK-RETRY',$tries);
+                $STATS{'CHARSOCK-RETRY'.&SelfStatId($self)} = "@print" ;
+            }
+
+            if (defined($count)) {
+                if ($count) {
+                    &RemoteBufSizeUpdate( $self, $Socket, $count );
+                    $total += $count ;
+                    &MAXSTAT('CHARSOCK-COUNT',$count);
+                    &UPSTAT('LINES-SOCK'.&SelfStatId($self,'full'),$lines);
+
+                } elsif ($lines) {
+                    &UPSTAT('LINES-SOCK-NOTSENT'.&SelfStatId($self,'full'),
+                        $lines);
+                    $lines -= &RetryLater($self,$buffer,\@print);
+                    $total = -1 unless ($total);
+                    last ;
+                }
+                last if $test ;
+
+            } elsif ($! == EPIPE) {
+                close($Socket);
+
+                if ($self->{TID}) {
+                    $loggertid = 0 if ($self->getKind eq 'Logger');
+                    &Warn("Communication has been reset with ".$self->getName);
+                    $do_check ++ ;
+
+                } elsif ( $Socket == $self->{DADDY} ) {
+                    $loggertid = 0 ;
+                    $MUSTQUIT ++ ;
+                    &Warn("Must quit as my socket to parent has been reset");
+                }
+
+            } else {
+                local $" = "' '" ;
+                &Debug("$Socket socket is busy, will retrying '@print' later");
+                $STATS{'SOCKET-ERROR-'.int($!).&SelfStatId($self)} =
+                    "Can't send '@print'";
+                $lines -= &RetryLater($self,$buffer,\@print);
+                $total = -1 unless ($total);
+                last ;
+            }
+
+            @print = () ;
+        }
+
+        last if $MUSTQUIT ;
+    }
+
+    &TIMESTAT('RealPrintSock');
+
+    if ($total) {
+        &MAXSTAT('MAX-TOTALSOCK'.&SelfStatId($self),$total);
+        &MAXSTAT('MAX-LINESOCK'.&SelfStatId($self),$lines);
+        return @{$buffer} ? - @{$buffer} : ( $lines ? $lines : $total );
+    }
+
+    return 0 ;
+}
+
+END {
+    if ( $COM_LOCKING ) {
+        # Close all locking file handles and clean any locking file
+        map { close($lockfh{$_}) ; /^$SERVICE_TMP/ and -e $_ and unlink $_ }
+            keys(%lockfh);
+    }
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
Index: /A2P/a2p/A2P/Tools.pm
===================================================================
--- /A2P/a2p/A2P/Tools.pm	(revision 3)
+++ /A2P/a2p/A2P/Tools.pm	(revision 3)
@@ -0,0 +1,465 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Some usefull subfunctions
+#
+
+package A2P::Tools;
+
+use strict;
+use integer;
+use Fcntl;
+use Errno qw( EINTR EACCES EAGAIN );
+use Encode 'from_to';
+use Fcntl qw(
+    :flock
+    O_CREAT O_RDWR F_GETLK F_SETLK F_SETLKW F_WRLCK F_UNLCK SEEK_SET
+    );
+use IO::Handle ;
+use DB_File ;
+use Time::HiRes qw( tv_interval gettimeofday usleep ) ;
+use A2P::Globals;
+use A2P::Syslog;
+
+BEGIN {
+    use Exporter ();
+    our ( $VERSION , @ISA , @EXPORT_OK );
+
+    $VERSION = sprintf "%s", q$Rev: 994 $ =~ /(\d[0-9.]+)\s+/ ;
+
+    @ISA = qw(Exporter);
+    @EXPORT_OK = qw(    &debugbuffer  &compute     &mychomp  &FreeSharedList
+                        &FcntlLocked  &getrusage   &ShortID  &WaitFcntlLocked
+                        &SharedList   &myreadline  &ms       &FcntlUnlocked
+                    );
+}
+our $VERSION ;
+
+sub mychomp( \$ ) {
+    my $buffer = shift ;
+    my $ret = 0 ;
+
+    $ret = chomp $$buffer ;
+
+    if ( ord( substr( $$buffer , -1 , 1 )) == 0x0D ) {
+        $$buffer = substr( $$buffer , 0 , length( $$buffer )-1 );
+        $ret ++;
+    }
+
+    # Strip from last spaces unless argument provided
+    while ( ! @_ and ord( substr( $$buffer , -1 , 1 )) == 0x40 ) {
+        $$buffer = substr( $$buffer , 0 , length( $$buffer )-1 );
+        $ret ++;
+    }
+
+    return $ret ;
+}
+
+sub myreadline(\*;\$) {
+    my ( $file , $buffer ) = @_ ;
+    my ( $char , $long , $ret ) = ( " " , 1 , 0 );
+
+    while ( $long and $char ne chr(0x0A) and ! eof($file)) {
+        $ret += $long = read( $file , $char , 1 );
+        $$buffer .= $char ;
+    }
+
+    return $ret ;
+}
+
+my $bugindex = '  0 1 2 3  4 5 6 7  8 9 A B  C D E F' ;
+
+sub debugbuffer {
+    my $buffer = shift ;
+    my $kind   = shift ;
+
+    # Force kind flag if no conversion is required
+    $kind = $TO_CONVERT unless ($DO_CONVERT);
+
+    # Will return an array of RAW buffer conversion
+    my $ref = [] ;
+
+    return $ref
+        if ( length( $buffer ) == 0 or $NO_SYSLOG_DEBUG ) ;
+
+    undef $kind
+        if ( defined($kind) and $kind ne "NO TEXT" );
+
+    if ( defined( $kind ) ) {
+        &Debug( " DEBUGBUFFER:$bugindex" ) ;
+        push @{$ref}, $bugindex ;
+
+    } else {
+        &Debug( " DEBUGBUFFER:$bugindex |      EBCDIC      |      ASCII       |" );
+        push @{$ref}, "$bugindex |      EBCDIC      |      ASCII       |" ;
+    }
+
+    my ( $len , $max ) = ( 16 , length( $buffer ) );
+
+    my $index = 0 ;
+    my ( $hex , $ebcdic , $ascii );
+
+INNER:
+    while ( $index < $max ) {
+OUTER:
+        while ( $index%$len < $len ) {
+            $hex = $ebcdic = $ascii = "" if ( $index%$len == 0 );
+
+            my $char = substr( $buffer , $index , 1 ) ;
+            my $chr  = ord( $char ) ;
+            $hex .= " " if ( $index%4 == 0 ) ;
+            $hex .= sprintf( "%02x" , $chr ) ;
+            unless (defined( $kind )) {
+                $ebcdic .= ( $chr & 127 < 32 ) ? "." : $char ;
+                &from_to( $char , $FROM_CONVERT , $TO_CONVERT );
+                $ascii .= ( ord($char) & 127 < 32 )? "." : $char ;
+            }
+            $index ++ ;
+            last OUTER if ( $index%$len == 0 );
+            last INNER if ( $index > $max );
+        }#OUTER
+
+        if ( defined( $kind ) ) {
+            &Debug( "DEBUGBUFFER:$hex" );
+            push @{$ref}, $hex ;
+
+        } else {
+            &Debug( "DEBUGBUFFER:$hex | $ebcdic | $ascii |" );
+            push @{$ref}, "$hex | $ebcdic | $ascii |" ;
+        }
+    }#INNER
+
+    if ( $index%$len ) {
+        unless (defined( $kind )) {
+            my $sp = $len - ($index%$len) ;
+            $hex .= " " x (2*$sp + $sp/4 ) . " | $ebcdic" . " " x $sp .
+                "  | $ascii" . " " x $sp . "  |";
+        }
+        &Debug( "DEBUGBUFFER:$hex" );
+        push @{$ref}, $hex ;
+    }
+
+    # Return RAW array to eventually be logged later as information after
+    # and error (exemple: bad format of PTX field)
+    return $ref ;
+}
+
+################################################
+# File locking direct system call
+# Wait a filehandle as argument
+
+# "s!s!l!l!l!" for 32bits env... for 64bits env, should use "s!s!QQl!"
+my $arch = qx/uname -p/ ;
+chomp $arch ;
+my $pack_string = $arch !~ /64$/ ? "s!s!l!l!l!" : "s!s!QQl!" ;
+my $write_lock_flock_struct = pack $pack_string, F_WRLCK, SEEK_SET, 0, 0, 0 ;
+sub FcntlLocked {
+    &UPSTAT('FCNTLLOCKED-CALL');
+    my $handle = shift ;
+
+    &Debug("Handle = $handle ".ref($handle)) if (defined($handle));
+
+    unless (ref($handle) =~ /^GLOB/) {
+        &Error("Can't only try locking defined handles");
+        return 0 ;
+    }
+
+    # Try to lock the file handle
+    fcntl( $handle, F_SETLK, $write_lock_flock_struct )
+        or &Debug("Can't lock handle with fcntl call: $! ".int($!)), return 0;
+
+    return 1;
+}
+
+sub WaitFcntlLocked {
+    &UPSTAT('WAITFCNTLLOCKED-CALL');
+    my $handle = shift ;
+
+    unless (ref($handle) =~ /^GLOB/) {
+        &Error("Can't only try locking defined handles");
+        return 0 ;
+    }
+
+    $! = 0 ;
+    # Try to lock the file handle retrying when interrupted
+    while ( ! fcntl( $handle, F_SETLKW, $write_lock_flock_struct )) {
+        last unless ( $! == EINTR );
+        $! = 0 ;
+    }
+
+    if ($!) {
+        &Debug("Can't waiting lock on handle with fcntl call: $! ".int($!));
+        return 0 ;
+    }
+
+    return 1;
+}
+
+# "s!s!l!l!l!" for 32bits env... for 64bits env, should use "s!s!QQl!"
+my $unlock_flock_struct = pack $pack_string, F_UNLCK, 0, 0, 0, 0 ;
+sub FcntlUnlocked {
+    &UPSTAT('FCNTLUNLOCKED-CALL');
+    my $handle = shift ;
+
+    unless (ref($handle) =~ /^GLOB/) {
+        &Error("Can't only try unlocking defined handles");
+        return 0 ;
+    }
+
+    $! = 0 ;
+
+    # Try to lock the file handle
+    fcntl( $handle, F_SETLK, $unlock_flock_struct )
+        or &Debug("Can't unlock handle with fcntl call: $! ".int($!)), return 0;
+
+    &Debug("Current system error: $! ".int($!)) if $! ;
+    return 1;
+}
+
+sub __NR_getrusage () { 77 }   # Value taken from <asm/unistd.h>
+
+################################################
+# getrusage system call
+sub getrusage {
+    my $who = shift || 0 ;
+    my $rusage = " " x ( 18 * 4 ) ; # Size of struc rusage
+    my @struct ;
+
+    if ( $who == 0 ) {
+        &Debug("Getting rusage for T$$");
+
+    } elsif ($who == -1 ) {
+        &Debug("Getting rusage for T$$ children");
+
+    } else {
+        &Error("Can't get rusage for $who");
+        return ();
+    }
+
+    $! = 0 ;
+    my $Ret = syscall( __NR_getrusage , $who , $rusage );
+    (&Debug("Can't getrusage with fcntl call: $!"), return ()) if ($Ret == -1);
+
+    #struct timeval (from bits/time.h)
+    #  {
+    #    __time_t tv_sec;       /* Seconds.  */       --> long int
+    #    __suseconds_t tv_usec; /* Microseconds.  */  --> long int
+    #  };
+
+    my (      #struct rusage { (from man getrusage)
+              #struct timeval ru_utime; /* user time used */
+                $ru_utime__tv_sec, $ru_utime__tv_usec,
+              #struct timeval ru_stime; /* system time used */
+                $ru_stime__tv_sec, $ru_stime__tv_usec,
+        $ru_maxrss,     # long   ru_maxrss;   /* maximum resident set size */
+        $ru_ixrss,      # long   ru_ixrss;    /* integral shared memory size */
+        $ru_idrss,      # long   ru_idrss;    /* integral unshared data size */
+        $ru_isrss,      # long   ru_isrss;    /* integral unshared stack size */
+        $ru_minflt,     # long   ru_minflt;   /* page reclaims */
+        $ru_majflt,     # long   ru_majflt;   /* page faults */
+        $ru_nswap,      # long   ru_nswap;    /* swaps */
+        $ru_inblock,    # long   ru_inblock;  /* block input operations */
+        $ru_oublock,    # long   ru_oublock;  /* block output operations */
+        $ru_msgsnd,     # long   ru_msgsnd;   /* messages sent */
+        $ru_msgrcv,     # long   ru_msgrcv;   /* messages received */
+        $ru_nsignals,   # long   ru_nsignals; /* signals received */
+        $ru_nvcsw,      # long   ru_nvcsw;    /* voluntary context switches */
+        $ru_nivcsw      # long   ru_nivcsw;   /* involuntary context switches */
+    );
+
+    @struct = unpack( "l!18" , $rusage );
+
+    return @struct ;
+}
+
+#========================================================================
+# Private table to compute identifier
+my @cons = split(//,'bcdfgjklmnprstvxz');
+my @voy  = split(//,'aeiou' );
+my ( $mC , $mV ) = ( scalar(@cons) , scalar(@voy) ) ;
+#========================================================================
+sub ShortID {
+    my $length = shift || 4 ;
+    my $id = "" ;
+    $id .= $length % 2 ? $cons[rand($mC)] : $voy[rand($mV)] while ( $length -- );
+    return $id ;
+}
+
+sub compute {
+    my ( $bufref , $pos , $long ) = @_ ;
+    my ( $ret , $mul ) = ( 0 , 1 ) ;
+
+    return &Error("[DEV] Unsupported use of 'compute' tool: long $long > 4")
+        if ( $long > 4 );
+
+    return &Error("[DEV] Unsupported use of 'compute' tool: long $long < 0")
+        if ( $long < 0 );
+
+    &Debug("Buffer is not as long as expected")
+        if ( $pos + $long > length( $$bufref ) );
+
+    # Avoid infinite loop if long is negative
+    while ( $long--  ) {
+        $ret += ord( substr( $$bufref , $pos + $long , 1 ) ) * $mul ;
+        $mul <<= 8 ;
+    }
+
+    return $ret ;
+}
+
+#========================================================================
+# SharedList is a facility to shared lists between processes
+my %lists = (
+    # Key = name of the list -> is also used to tie the list
+    # Value = Array ref: [
+    #   Array ref of the tied list
+    #   Array ref to a list of values to push in tied list
+    #   FileHandle of the locking file if tied or 0
+    # ]
+    ) ;
+sub SharedList {
+    # Return an array ref to which push values
+    my $list = shift || 'shared_list_of_lost_values' ;
+    my $List = uc($list) ;
+
+    my $force = shift || 0 ;
+
+    $! = 0 ;
+
+    # The shared list should better be in shared memory
+    my $base = $SHMDIR . '/.shared-list-' . $list ;
+
+    # 1. Initiliaze hash if not done in our processus
+    unless (exists($lists{$list})) {
+        $lists{$list} = [ [], [], 0 ] ;
+    }
+
+    # 2. Get the array refs for that list
+    my ( $tied, $kept, $fh ) = @{$lists{$list}} ;
+    &Debug("FileHandle not previously released for $list list locking")
+        if ($fh);
+
+    # 3. Try to open files and tie list and return $kept ref on any error
+    # 3.1. Open LCK file
+    undef $fh ;
+    unless (open($fh, '>', $base.'.LCK')) {
+        &UPSTAT('SHARED-LIST-OPEN-ERRNO-'.int($!));
+        &Debug("Can't open $base.LCK lock file: $!");
+        return $kept ;
+    }
+
+    # 3.2. Lock file without blocking
+    unless (flock($fh, $force ? LOCK_EX : LOCK_EX | LOCK_NB)) {
+        &UPSTAT('SHARED-LIST-LOCK-ERRNO-'.int($!));
+        # Only log on other error than ressource is busy (EAGAIN)
+        &Debug("Can't lock $list list: $!") unless ($! == EAGAIN);
+        close ($fh);
+        return $kept ;
+    }
+    &TIMESTAT('SHARED-LIST-LOCKED-'.$List);
+    &TIMESTAT('SHARED-LIST-GET-TIED-'.$List);
+
+    # Keep internal statistics on DB_File size
+    &MAXSTAT('SHARED-LIST-FILE-SIZE-'.$List,(-s $base));
+
+    # 3.3. Tie the list
+    my @tied ;
+    unless (tie @tied, 'DB_File', $base, O_CREAT|O_RDWR, oct(660), $DB_RECNO ) {
+        &UPSTAT('SHARED-LIST-TIE-ERRNO-'.int($!));
+        &Debug("Can't tie $list list: $!");
+        &TIMESTAT('SHARED-LIST-GET-TIED-'.$List);
+        flock($fh, LOCK_UN);
+        &TIMESTAT('SHARED-LIST-LOCKED-'.$List);
+        close ($fh);
+        return $kept ;
+    }
+    &TIMESTAT('SHARED-LIST-GET-TIED-'.$List);
+    &TIMESTAT('SHARED-LIST-TIED-'.$List);
+
+    # 3.4. File is locked and tied, keep this information
+    $lists{$list}->[0] = \@tied ;
+    $lists{$list}->[2] = $fh ;
+    &UPSTAT('SHARED-LIST-TIED-'.$List);
+
+    # 4. Inject now kept values
+    if (@{$kept}) {
+        &UPSTAT('SHARED-LIST-INJECT-KEPT-'.$List);
+        &MAXSTAT('SHARED-LIST-KEPT-'.$List,scalar(@{$kept}));
+        push @tied, @{$kept};
+        # Keep the kept reference as empty array
+        $lists{$list}->[1] = [] ;
+    }
+
+    # 5. Return the ref to the tied array
+    return \@tied ;
+}
+
+sub FreeSharedList {
+    # Free a shared list
+    my $list = shift || 'shared_list_of_lost_values' ;
+    my $List = uc($list) ;
+
+    # 1. Initiliaze hash if not done in our processus
+    unless (exists($lists{$list})) {
+        &Debug("Can't free not shared $list list");
+        return 0 ;
+    }
+
+    # 2. Get the array refs for that list
+    my ( $tied, $kept, $fh ) = @{$lists{$list}} ;
+
+    # 3. Untie the list is really tied and locked
+    if ($fh) {
+        my $tied_array = tied(@{$tied}) ;
+        if (defined($tied_array)) {
+            &UPSTAT('SHARED-LIST-SYNC-'.$List);
+            $tied_array->sync ;
+            undef $tied_array ;
+        }
+
+        # Untie the array
+        untie @{$tied} ;
+        &TIMESTAT('SHARED-LIST-TIED-'.$List);
+
+        # Unlock the lock file
+        flock($fh, LOCK_UN);
+        &TIMESTAT('SHARED-LIST-LOCKED-'.$List);
+        close ($fh);
+        $lists{$list}->[2] = 0 ;
+        &UPSTAT('SHARED-LIST-UNTIED-'.$List);
+    }
+}
+
+sub ms {
+    # Avoid use of integer to support large integer on 32 bits platforms
+    no integer ;
+
+    # Get current millisecond
+    my ( $sec , $usec ) = &gettimeofday() ;
+
+    # If a parameter is defined, we want to add the seconds with it. It could be
+    # a negative number to get a timer to compare
+    $sec += shift if @_ ;
+
+    return int( $sec * 1000 + $usec / 1000 ) ;
+}
+
+1;
Index: /A2P/a2p/A2P/XML.pm
===================================================================
--- /A2P/a2p/A2P/XML.pm	(revision 3)
+++ /A2P/a2p/A2P/XML.pm	(revision 3)
@@ -0,0 +1,903 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Class to implement some XML support
+#
+
+package A2P::XML;
+
+use strict;
+use Fcntl ':flock';
+use File::stat ;
+use XML::LibXML ;
+use Time::HiRes qw( time );
+use MIME::Base64 ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use A2P::Tools qw( ShortID );
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 415 $ =~ /(\d[0-9.]+)\s+/ ;
+}
+our $VERSION ;
+
+# Private variables
+my %DTD = {} ;
+my %IDs = {} ;
+
+sub id {
+    my $time = time ; # time is here the Time::HiRes 'time' version
+    my @Date = localtime($time);
+    my $DayTick = ($time - int($time - ( $Date[0] + $Date[1]*60 + $Date[2]*3600 ))) * 193 ;
+    my $id ;
+    while ( ! defined($id) or defined($IDs{$id}) ) {
+        $id = sprintf( "XML-%c%03D-%06X-%s", $Date[5]-40 , $Date[7] , $DayTick, &ShortID ) ;
+    }
+    $IDs{$id} = 1 ;
+    return $id ;
+}
+
+sub new {
+    &Debug("new " . __PACKAGE__ . " v$VERSION");
+    my $class = shift ;
+    my $self  = {
+        XMLREF =>  @_ ? shift : undef ,
+        ID     =>  &id(),
+        ERROR  =>  [],    NODES   =>  {},    LASTPARSEDFILE  =>  "",
+        XML    =>  "",    NODEID  =>  "",
+        DTD    =>  "",    DTDNAME =>  ""
+        };
+
+    &Debug("New XML object is identified with $self->{ID} tag");
+    return bless $self , $class ;
+}
+
+################################################################################
+#
+#                           Common APIs
+#
+################################################################################
+sub getParser {
+    my $self = shift ;
+    return $self->{PARSER} if (defined($self->{PARSER}));
+
+    # Read Destination configuration file to set needed options
+    &Debug("Creating new XML parser for $self->{ID}");
+    my $parser = XML::LibXML->new();
+    return $self->error(401,"Unable to get an XML parser: $!")
+        unless (defined($parser));
+
+    return $self->{PARSER} = $parser ;
+}
+
+sub clearParsedNodes {
+    my $self   = shift ;
+    undef $self->{TREE} ;
+    $self->{NODES}  = {} ;
+    $self->{NODEID} = "" ;
+}
+
+sub parse_file {
+    my $self = shift ;
+    my $file = shift ;
+    my $parser ;
+
+    # Check file is existing
+    return $self->error(402, defined($file) ?
+        "'$file' XML file doesn't exist" : "No file to parse provided")
+        unless ( defined($file) and $file and -e $file );
+
+    # Get file time creation to check if we need to reload
+    my $stat = stat($file);
+    my $mtime = $stat->mtime();
+
+    # Check if we still have parsed this file and it has not changed
+    if ( $self->{LASTPARSEDFILE} eq $file ) {
+        # The mandatory point to parse again the file is to found a
+        # different mtime on file, this should garanty to reload the
+        # file at last in the second
+        if ( $mtime == $self->{MTIMEPARSEDFILE} ) {
+            &Debug("File to parse still known, keeping cached parsing");
+            return $file ;
+
+        } else {
+            &Debug("XML file has been modified");
+            # When we need to reload conf, we should free some structures
+            $self->clearParsedNodes();
+        }
+    }
+
+    # Check with can parse file
+    return $self->error(403, "No parser available to read XML file")
+        unless ( $parser = $self->getParser() );
+
+    &Debug("Parsing '$file' XML file");
+    $self->{XML} = $parser->parse_file( $file );
+    if (defined($self->{XML})) {
+        $self->{MTIMEPARSEDFILE} = $mtime ;
+
+        if ($ADVANCED_DEBUGGING) {
+            my $confdump = $self->{XML}->toString(2) ;
+            &Debug( "XML conf: '" .
+                ( length($confdump) > 160 ?
+                    substr($confdump,0,160) . "..."
+                    :
+                    $confdump
+                )."'" );
+        }
+
+    } else {
+        $self->error(404,"Got XML Parsing error with '$file': $!");
+        $file = "" ;
+    }
+
+    if ($ENABLE_DTD_VALIDATION and $file and $self->{DTD}) {
+        my $valid = eval { $self->{XML}->is_valid($self->{DTD}) } ;
+        if ( ! $valid ) {
+            my $error = $parser->get_last_error() ;
+            $error = defined($error) ? ", $error" : "" ;
+            chomp $error ;
+            $self->error(405,"'$file' XML document is not valid toward '$self->{DTDNAME}'$error");
+            $file = "" ;
+
+        } else {
+            &Debug("'$file' is conform toward '$self->{DTDNAME}' DTD");
+        }
+    }
+
+    return $self->{LASTPARSEDFILE} = $file ;
+}
+
+sub parseNodesById {
+    my $self = shift ;
+
+    # Really parse only if it has not been done before
+    unless ( keys(%{$self->{NODES}}) ) {
+        &Debug("Parsing nodes tree by Id");
+        foreach my $node ( @{$self->{TREE}} ) {
+            my $nodeid = $node->getAttribute('Id');
+            $self->{NODES}->{$nodeid} = $node ;
+        }
+    }
+}
+
+sub get {
+    my $self = shift ;
+    my $what = shift ;
+    my $key  = '__' . $what ;
+
+    return $self->error(406,"Nothing to seach provided")
+        unless (defined($what) and $what );
+
+    my $nodeid = $self->{NODEID} ;
+    return $self->error(407,"Can't seach as no node as been selected")
+        unless ($nodeid);
+
+    return defined($self->{$key}->{$nodeid}) ?
+        $self->{$key}->{$nodeid}
+        :
+        $self->{$key}->{$nodeid} = $self->{NODES}->{$nodeid}->findvalue($what)
+        ;
+}
+
+sub getAttribute {
+    my $self = shift ;
+    my $what = shift ;
+    my $key  = '__' . $what ;
+
+    return $self->error(411,"Nothing to seach provided")
+        unless (defined($what) and $what );
+
+    my $nodeid = $self->{NODEID} ;
+    return $self->error(412,"Can't seach as no node as been selected")
+        unless ($nodeid);
+
+    return defined($self->{$key}->{$nodeid}) ?
+        $self->{$key}->{$nodeid}
+        :
+        $self->{$key}->{$nodeid} = $self->{NODES}->{$nodeid}->getAttribute($what)
+        ;
+}
+
+sub concatenate {
+    my $self = shift ;
+
+    return &Error("[DEV] Can't concatenate without scalar ref as XMLREF")
+        unless (ref($self->{XMLREF}) =~ /^SCALAR/);
+
+    my $line = shift || "" ;
+
+    return ${$self->{XMLREF}} .= $line ;
+}
+
+sub parse_string {
+    my $self = shift ;
+    my $parser ;
+
+    # Check with can parse a string
+    return $self->error(408, "No parser available to analyse string")
+        unless ( $parser = $self->getParser() );
+
+    return $self->error(409, "No string to analyse")
+        unless ( ref($self->{XMLREF}) =~ /^SCALAR$/ );
+
+    $self->{XML} = $parser->parse_string( ${$self->{XMLREF}} );
+    unless (defined($self->{XML})) {
+        $self->error(410,"Got XML Parsing error on '${$self->{XMLREF}}': $!");
+        $self->{XML} = 0 ;
+    }
+
+    if ($ENABLE_DTD_VALIDATION and $self->{XML} and $self->{DTD} ) {
+        my $valid = eval { $self->{XML}->is_valid($self->{DTD}) } ;
+        if ( ! $valid ) {
+            my $error = $parser->get_last_error() ;
+            $error = defined($error) ? ", $error" : "" ;
+            my $xml = ${$self->{XMLREF}} ;
+            chomp $error ;
+            chomp $xml ;
+            $self->error(411,"'$xml' XML string is not valid toward '$self->{DTDNAME}'$error");
+            $self->{XML} = 0 ;
+
+        } else {
+            &Debug("XML string is conform toward '$self->{DTDNAME}' DTD");
+        }
+    }
+
+    return $self->{XML} ;
+}
+
+sub getid {
+    return $_[0]->{ID} ;
+}
+
+sub toString {
+    my $self = shift ;
+    my $format = shift || 0;
+
+    my $doc = $self->{XML} ;
+
+    unless (defined($doc) and ref($doc) =~ /^XML/) {
+        $self->error(412,"No XML to return");
+        return "" ;
+    }
+
+    # Return the XML as original format string by default
+    my $string = $doc->toString($format) ;
+    &Debug( "Returning XML string: '" .
+        ( length($string) > 160 ?
+            substr($string,0,160) . "..."
+            :
+            $string
+        ) . "'" )
+        if ($ADVANCED_DEBUGGING);
+
+    return $string;
+}
+
+sub setDTD {
+    my $self = shift ;
+    my $name = shift || "" ;
+    return &Error("No DTD name provided") unless $name ;
+    return &Error("No such '$name' DTD available")
+        unless (defined($DTD{$name}));
+    &Debug("Selecting '$name' DTD");
+    $self->{DTD} = $DTD{$self->{DTDNAME} = $name} ;
+}
+
+################################################################################
+#
+#                         ControlRecord dedicated API
+#
+################################################################################
+# Provides the selection of the right NODE in the XML
+# Then we can use 'get' API to retreive destid values
+sub selectDestId {
+    my $self   = shift ;
+    my $destid = shift ;
+
+    return $self->error(450,"No destid provided")
+        unless (defined($destid) and $destid );
+
+    &Debug("Getting Destinations node in XML");
+    my $TREE = $self->getDestinations();
+    return $self->error(451,"No destination tree found".($!?" $!":""))
+        unless @{$TREE} ;
+
+    $self->parseNodesById();
+
+    unless (defined($self->{NODES}->{$destid})) {
+        $self->error(452,"No configuration found for DestID '$destid'");
+        return "" ;
+    }
+
+    return $self->{NODEID} = $destid ;
+}
+
+sub selectDocument {
+    my $self = shift ;
+    my $doc  = shift ;
+
+    return $self->error(453,"No document name provided")
+        unless (defined($doc) and $doc );
+
+    &Debug("Getting Documents node in XML");
+    my $TREE = $self->getDocuments();
+    return $self->error(454,"No Document tree found".($!?" $!":""))
+        unless @{$TREE} ;
+
+    $self->parseNodesById();
+
+    unless (defined($self->{NODES}->{$doc})) {
+        &Debug("No configuration found for Document '$doc'");
+        return "" ;
+    }
+
+    return $self->{NODEID} = $doc ;
+}
+
+sub getDestinations {
+    my $self = shift ;
+
+    # Return cached TREE
+    return $self->{TREE} if (defined($self->{TREE}));
+
+    &Debug("Searching Destination nodes in XML");
+    my @TREE = $self->{XML}->getElementsByTagName("Destination");
+    return $self->{TREE} = \@TREE ;
+}
+
+sub getDocuments {
+    my $self = shift ;
+
+    # Return cached TREE
+    return $self->{TREE} if (defined($self->{TREE}));
+
+    &Debug("Searching Document nodes in XML");
+    my @TREE = $self->{XML}->getElementsByTagName("Document");
+    return $self->{TREE} = \@TREE ;
+}
+
+################################################################################
+#
+#                       E-Service dedicated API
+#
+################################################################################
+sub getbin {
+    my $self = shift ;
+    my $name = shift ;
+    my $exec ;
+
+    $self->error(0);
+    $! = 0 ;
+
+    return $self->error(480,"No service name provided")
+        unless (defined($name) and $name );
+
+    &Debug("Getting E-Services node in XML");
+    my $TREE = $self->getEServices();
+    return $self->error(481,"No E-Service tree found".($!?" ($!)":""))
+        unless @{$TREE} ;
+
+    # Really parse only if it has not been done before
+    unless ( keys(%{$self->{NODES}}) ) {
+        &Debug("Parsing nodes tree by name");
+        foreach my $node ( @{$self->{TREE}} ) {
+            my $service = $node->getAttribute('name');
+            unless (defined($name) and $name) {
+                &Warn("Skipping bad service node without name attribut '" .
+                    $node->toString() . "'");
+                next ;
+            }
+
+            $exec = $node->getAttribute('exec');
+            unless (defined($exec) and $exec) {
+                &Warn("Skipping bad service node without exec attribut '" .
+                    $node->toString() . "'");
+                next ;
+            }
+
+            &Warn("'$service' E-Service definition seems to use and non existing '" .
+                $exec . "' program")
+                    unless (-e $exec);
+
+            &Warn("'$service' E-Service definition seems to use and non executable '" .
+                $exec . "' program")
+                    unless (-x $exec);
+
+            my $mode = $node->getAttribute('mode');
+            unless (defined($exec) and $exec) {
+                &Debug("No service node mode attribut found in '" .
+                    $node->toString() . "', taking default");
+                $mode = 0 ;
+            }
+
+            &Debug("Registring node '$service' with exec '$exec' and mode '$mode'")
+                 if ($ADVANCED_DEBUGGING);
+            $self->{NODES}->{$service} = [ $exec , $mode ] ;
+        }
+    }
+
+    unless (defined($self->{NODES}->{$name})) {
+        $self->error(482,"No configuration found for E-Service '$name'");
+        return "" ;
+    }
+
+    $exec = $self->{NODES}->{$name}->[0] || "" ;
+
+    return $self->error(483,"Requested E-Service '$name' uses not existing '$exec' program")
+        unless ( -e $exec );
+
+    # Check if its a link if not executable
+    my $maxlink = 10 ; # Even if link loop should not pass the 483 error, its better
+    # to keep as reasonnable loop exit condition
+    my $link = $exec ;
+    while ( ! -x _ and $maxlink -- ) {
+        if ( -l $link ) {
+            $link = readlink $link ;
+            return $self->error(483,"Requested E-Service '$name' uses a '$exec' link to a not existing '$link' program")
+                unless ( -e $link );
+
+        } else {
+            last ;
+        }
+    }
+
+    return $self->error(484,"Too much link found behind '$exec'")
+        if ( $maxlink < 0 );
+
+    return $self->error(485,"Requested E-Service '$name' uses not executable '$link' program" .
+            ($link ne $exec?" as '$exec' link":""))
+        unless ( -x _ );
+
+    return @{$self->{NODES}->{$name}} ;
+}
+
+sub getEServices {
+    my $self = shift ;
+
+    # Return cached TREE
+    return $self->{TREE} if (defined($self->{TREE}));
+
+    &Debug("Searching any service node in XML") if ($ADVANCED_DEBUGGING);
+    my @TREE = $self->{XML}->getElementsByTagName("service");
+
+    &Debug("Tree nodes: @TREE") if ($ADVANCED_DEBUGGING);
+    return $self->{TREE} = \@TREE ;
+}
+
+
+################################################################################
+#
+#                       External requests dedicated API
+#
+################################################################################
+# Provides access to the NODE <a2p /> xml validation
+sub isA2P_valid {
+    my $self   = shift ;
+    my $strict = shift || 0 ;
+
+    # 1. Parse buffer as string
+    my $doc = $self->parse_string ;
+    return $strict ? $self->error(460,"Not an XML document") : 0
+        unless ( ref($doc) =~ /^XML::LibXML::Document$/ );
+
+    # 2. Check doc is valid
+    # TODO We need to validate toward a DTD
+    #my $dtd = $self->getDTD('a2p');
+    #return $strict ? $self->error(461,"Not a valid XML A2P object") : 0
+    #    unless ($doc->is_valid($dtd));
+
+    return $doc ;
+}
+
+# Provides access to the NODE <a2p /> to handle conversion request
+sub isA2P {
+    my $self = shift ;
+
+    # 1. Parse and validate buffer
+    $self->setDTD('a2p-listener.dtd');
+    my $doc = $self->isA2P_valid('strict') ;
+    return 0 unless ( $doc and ref($doc) =~ /^XML::LibXML::Document$/ );
+
+    # 2. Check document format: we must have an a2p node as root
+    return $self->error(462,"Document has no 'a2p' node")
+        unless ( $doc->hasChildNodes and $doc->getChildNodes->size == 1 and
+            $doc->lastChild->nodeName eq 'a2p');
+
+    my $a2p = $doc->lastChild ;
+    my @nodes = map { $_->nodeName } $a2p->getChildNodes ;
+    &Debug("Available nodes: @nodes");
+
+    # 3. We need at least a path or a content node
+    return 0 unless grep { /^(path|content)$/i } @nodes ;
+
+    # 4. Still select A2P comportement
+    my $key = 'CONTENT' ;
+    $key = 'PATH' if (grep { /^path$/i } @nodes);
+
+    # Initializes few things
+    $self->{MESSAGE} = [ "A2P-XML-Object = ".$self->{ID} ] ;
+    $self->{PDFS} = [] ;
+    $self->{STATE} = 0 ;
+
+    foreach my $node ( $a2p->getChildNodes ) {
+        next unless ( $node->nodeName =~ /^$key$/i );
+
+        # Check eventually type attribut
+        my $type = $node->getAttribute("type");
+        return $self->error(464,"Type '$type' conversion not supported")
+            if (defined($type) and $type =~ /^afp$/i );
+
+        $self->{$key} = $node->textContent() ;
+        $self->{$key} = "" unless (defined($self->{$key}));
+    }
+
+    return defined($self->{PATH}) and $self->{PATH} ? 1 : 0
+        if ( $key eq 'PATH' );
+
+    # key = CONTENT as AFP EBCDIDC base64 encoded flux
+    &Debug("Got base64 content to convert");
+    $self->{CONTENT} = &decode_base64( $self->{CONTENT} ) ;
+    $self->{PATH} = $SHMDIR . '/AFP.' . $self->{ID} ;
+
+    open AFP, ">" .$self->{PATH}
+        or return $self->error(463,"Can't open temporary file to save AFP content: $!");
+
+    # Lock the file just in case
+    my $locked = flock(AFP, LOCK_EX | LOCK_NB);
+    return $self->error(465,"Can't lock file for AFP content: $!")
+        unless $locked ;
+
+    my $print = print AFP $self->{CONTENT}
+        or $self->error(466,"Can't write file with AFP content: $!");
+
+    flock(AFP, LOCK_UN);
+    close(AFP);
+
+    return $print ;
+}
+
+# Provides access to the NODE <a2p /> as E-Service request
+sub isA2P_eService {
+    my $self = shift ;
+
+    # 1. Parse and validate buffer or return without error
+    $self->setDTD('a2p-eservice.dtd');
+    my $doc = $self->isA2P_valid('') ;
+    return 0 unless ( $doc and ref($doc) =~ /^XML::LibXML::Document$/ );
+
+    # 2. Check document format: we must have an a2p node as root
+    return $self->error(472,"Document has no 'a2p' node")
+        unless ( $doc->hasChildNodes and $doc->getChildNodes->size == 1 and
+            $doc->lastChild->nodeName eq 'a2p');
+
+    my $a2p = $self->{A2P} = $doc->lastChild ;
+    my @nodes = () ;
+
+    # 3. Keep ref to service node and check it exists
+    foreach my $node ( $a2p->getChildNodes ) {
+        my $nodename = $node->nodeName ;
+        push @nodes , $nodename ;
+        next unless ( $nodename =~ /^service$/i );
+        $self->{SERVICE} = $node ;
+    }
+
+    unless (grep { /^service$/i } @nodes and defined($self->{SERVICE})) {
+        $self->error(473,"XML request must content a 'service' node");
+        &Info("Available nodes: @nodes");
+        return 0 ;
+    }
+
+    &Debug("Available nodes: @nodes");
+
+    # 4. Check name attribut is defined
+    my $name = $self->{SERVICE}->getAttribute("name");
+    return $self->error(474,"No service name found to handle request")
+        unless (defined($name) and $name );
+
+    return $self->error(475,"'$name' found service name is prohibited")
+        if ( $name eq '200' );
+
+    &Debug("Claimed E-Service is '$name'");
+    $self->{'E-SERVICE'} = $name ;
+
+    # 5. Check pdf and file attribut for just overriding warns
+    my $pdf = $self->{SERVICE}->getAttribute("pdf");
+    &Warn("service node 'pdf' attribut with value '$pdf' will be lost")
+        if (defined($pdf) and $pdf );
+
+    my $file = $self->{SERVICE}->getAttribute("file");
+    &Warn("service node 'file' attribut with value '$file' will be lost")
+        if (defined($file) and $file );
+
+    # 6. Returns E-Service name as true value
+    return $name ;
+}
+
+sub set_a2p_attribut {
+    my $self = shift ;
+    my $name  = shift || "" ;
+    my $value = shift || "" ;
+    return 0 unless (defined($self->{A2P}) and $name and $value);
+
+    $self->{A2P}->setAttribute( $name , $value );
+
+    return $self->{A2P}->hasAttribute( $name );
+}
+
+sub A2Panswer {
+    my $self = shift ;
+    return join("\n",( @{$self->{MESSAGE}}, $self->error ))
+        unless ( ref($self->{XML}) =~ /^XML::LibXML::Document$/ );
+    # We need to update XML and return its text version
+    my $a2p = $self->{XML}->lastChild ;
+    my $lastnode = 0 ;
+
+    my $key = 'PATH' ;
+    $self->{PATH} = (defined($self->{PDFS}) and @{$self->{PDFS}})?
+        shift @{$self->{PDFS}} : "" ;
+
+    # Update path or content
+
+    if (defined($self->{CONTENT})) {
+        $key = 'CONTENT' ;
+        open PDF, $self->{PATH}
+            or return $self->error(467,"Can't open pdf file for reading: $!");
+
+        $self->{CONTENT} = &encode_base64(join('',<PDF>));
+        close(PDF);
+
+        # Delete PDF as it is requested
+        unlink $self->{PATH} ;
+    }
+
+    if (defined($self->{PATH}) and $self->{PATH}) {
+        foreach my $node ( $a2p->getChildNodes ) {
+            next unless ( $node->nodeName =~ /^$key$/i );
+
+            $lastnode = $node->cloneNode ;
+            $lastnode->appendText( $self->{$key} );
+            $lastnode->setAttribute("type","pdf");
+            $node->replaceNode( $lastnode );
+
+            # We must have only one node to update
+            last ;
+        }
+
+    } else {
+        $self->A2Pabterm ;
+        $self->error(470,"No pdf generated: '$_'");
+        $self->A2Pmessage("A2P-Error-XML-no-pdf-available");
+    }
+
+    # Check we don't received another PDF or we didn't update the node
+    if ( defined($self->{PDFS}) and @{$self->{PDFS}} ) {
+        map {
+            $self->error(468,"Too much pdf generated: '$_'");
+            $self->A2Pmessage("A2P-Error-Other-PDF = $_");
+            $self->A2Pabterm ;
+            } @{$self->{PDFS}} ;
+
+    } elsif ( defined($self->{PDFS}) and ! $lastnode ) {
+        $self->A2Pabterm ;
+        $self->error(469,"Too much pdf generated: '$_'");
+        $self->A2Pmessage("A2P-Error-XML-not-updated");
+    }
+
+    # Set return code
+    my $RC = sprintf("%02d",$self->{STATE}) ;
+    my ( $returnCode ) = grep { $_->nodeName =~ /^ReturnCode$/i } $a2p->getChildNodes ;
+    if (defined($returnCode)) {
+        $lastnode = $returnCode->cloneNode ;
+        $lastnode->appendText( $RC );
+        $returnCode->replaceNode( $lastnode );
+
+    } else {
+        $a2p->appendTextChild( "returnCode", $RC );
+    }
+
+    # Set messages on bad status
+    $a2p->appendTextChild( "message", join("\n",@{$self->{MESSAGE}}) )
+        if ($self->{STATE});
+
+    my $answer = $self->{XML}->toString ;
+    &Debug("XML answer is '$answer'");
+    return $answer ;
+}
+
+sub A2Pmessage {
+    my $self = shift ;
+    &Debug("Got XML message as '@_'");
+    push @{$self->{MESSAGE}}, @_ ;
+}
+
+sub A2Ppdf {
+    my $self = shift ;
+    push @{$self->{PDFS}}, @_ ;
+}
+
+sub getPATH {
+    my $self = shift ;
+    return defined($self->{PATH}) ? $self->{PATH} : "" ;
+}
+
+sub A2Pabterm {
+    $_[0]->{STATE} ++ ;
+}
+
+sub setstate {
+    my $self = shift ;
+
+    my $state = shift ;
+    my $path = $DONESPOOL ;
+
+    # Check state
+    unless ($state =~ /^OK$/i) {
+        $path = $ERRORSPOOL ;
+        $self->{STATE} ++ ;
+    }
+
+    # Update PDFs path
+    @{$self->{PDFS}} = map { $path . '/' . $_ } @{$self->{PDFS}} ;
+}
+
+################################################################################
+#
+#                           General common APIs
+#
+################################################################################
+sub error {
+    my $self = shift ;
+    if ( @_ ) {
+        my ( $errno , $msg ) = @_ ;
+
+        # Reset ERROR when requested
+        return @{$self->{ERROR}} = ( 0 )
+            unless (defined($errno) and $errno );
+
+        return 0 unless (defined($msg));
+
+        push @{$self->{ERROR}} , $msg ;
+        &Error( "Error $errno: $msg on " . $self->{ID} );
+        return 0 ;
+
+    } else {
+        return wantarray ? grep { ! /^\d+$/ } @{$self->{ERROR}} : $self->{ERROR}->[0] ;
+    }
+}
+
+sub DESTROY {
+    my $self = shift;
+    my @err  = @{$self->{ERROR}} ;
+
+    if (@err) {
+        &UPSTAT('GET-XML-ERROR');
+        &UPSTAT('GET-XML-ERROR-' . $err[0] );
+        &Debug($self->{ID} . " XML object destroyed with error #" . $err[0]);
+
+    } else {
+        &UPSTAT('GOT-GOOD-XML');
+        &Debug($self->{ID} . " XML object destroyed");
+    }
+
+    delete $IDs{$self->{ID}} ;
+}
+
+################################################################################
+### Load default inline DTDs ###################################################
+################################################################################
+sub SaveDTD ( $ \$ ) {
+    my $name   = shift || "" ;
+    my $buffer = shift ;
+
+    return &Error("No name provided to keep DTD in memory")
+        unless $name ;
+
+    unless ($$buffer) {
+        &Debug("Nothing to save for '$name' DTD");
+        return 1 ;
+    }
+
+    my $string = $$buffer ;
+
+    # Empty the buffer
+    $$buffer = "" ;
+
+    &Debug("Saving '$name' DTD in memory...");
+    $DTD{$name} = XML::LibXML::Dtd->parse_string($string);
+}
+
+{
+    my ( $name , $buffer , $count ) = ( "" , "" , 0 );
+    $! = 0 ;
+
+    &Debug("Loading default DTD definitions...");
+    while (<DATA>)
+    {
+        next if /^\s*$/ ; # Skip empty lines
+        next if /^####/    ; # Skip big comment lines
+        chomp ;
+
+        # Start a new DTD
+        if (/^### DTD\s+'([^']*)'/) {
+            die "Can't initialize '$name' DTD: $!\n"
+                unless (!$name or
+                ($name and $buffer and &SaveDTD($name,\$buffer) and ++ $count));
+
+            $name = $1 ;
+            &Debug("Reading '$name' DTD...");
+            next ;
+        }
+
+        $buffer .= $_ . "\n" ;
+    }
+
+    # Save last DTD
+    die "Can't initialize '$name' DTD: $!\n"
+        unless ($name and $buffer and &SaveDTD($name,\$buffer));
+
+    close(DATA);
+
+    &Debug("$count DTD loaded");
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
+################################################################################
+### Each DTD is defined by an id and a name from the following format line   ###
+### After the __DATA__ inline tag                                            ###
+### DTD 'id' 'name'  any string as comment for example                       ###
+################################################################################
+
+__DATA__
+################################################################################
+### DTD 'a2p-listener.dtd' A2P Listener DTD                                  ###
+################################################################################
+<!ELEMENT a2p ( (path|content) , (returnCode)* , (message)* )+ >
+<!ELEMENT path          ANY >
+<!ELEMENT content       ANY >
+<!ELEMENT returnCode    ANY >
+<!ELEMENT message       ANY >
+
+################################################################################
+### DTD 'a2p-eservice.dtd' A2P E-Service DTD                                 ###
+################################################################################
+<!ELEMENT a2p ( service )+ >
+<!ELEMENT service ANY >
+<!ATTLIST a2p
+                    pdf          CDATA   #IMPLIED
+                    file         CDATA   #IMPLIED
+>
+<!ATTLIST service
+                    name         CDATA   #REQUIRED
+>
+
+################################################################################
+### DTD 'e-service.conf.dtd' Configuration E-Service DTD                     ###
+################################################################################
+<!ELEMENT conf ( service )* >
+<!ELEMENT service EMPTY >
+<!ATTLIST service
+                    name         CDATA   #REQUIRED
+                    exec         CDATA   #REQUIRED
+                    mode         (0|1)   #REQUIRED
+>
Index: /A2P/a2p/A2P/archivage.pm
===================================================================
--- /A2P/a2p/A2P/archivage.pm	(revision 3)
+++ /A2P/a2p/A2P/archivage.pm	(revision 3)
@@ -0,0 +1,232 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+################################################################################
+# author      : yves mantel <ymantel@consultas.ch>
+# adaptation  : guillaume bougard <gbougard@pkg.fr>
+# description : naca archiving load client template
+################################################################################
+
+package A2P::archivage;
+
+use strict;
+use Errno qw(:POSIX);
+use IO::Socket;
+use IO::File;
+use IO::Handle qw( autoflush );
+use MIME::Base64;
+use Time::HiRes qw(usleep);
+use Benchmark;
+use A2P::Globals;
+use A2P::Syslog;
+
+BEGIN {
+    use Exporter ();
+
+    our ( $VERSION , @ISA , @EXPORT );
+
+    $VERSION = sprintf "%s", q$Rev: 876 $ =~ /(\d[0-9.]+)\s+/ ;
+
+    @ISA = qw(Exporter);
+    @EXPORT = qw( $SOCK &ArchivageMain );
+}
+our $VERSION ;
+
+our $SOCK ;
+
+# command parameters
+my $root_filename ;       # root filename, used to construct pdf and prt filename
+my $pdf_filename ;
+my $prt_filename ;
+
+# Other variables used in module version and for multi-threading
+my $LOGFILE ; # Private file handle for archivage logging
+
+my $ArchError = 0 ;
+
+################################################################################
+#
+# Archivage main template
+#
+################################################################################
+sub ArchivageMain() {
+
+   ($root_filename) = @_ ;
+   $ArchError = 0 ;
+   # Adapted original implementation of archivage.pl main function
+   if ($ARCH_DEBUG) {
+      # The arch debug file extension should be reported in A2P::Job
+      # get_arch_file member. If modified as we need to move it to result folder
+      open ($LOGFILE,">>$root_filename.arch_debug.txt")
+         or &Error("Can't open '$root_filename.arch_debug.txt' for writing: $!");
+   }
+
+   &init;
+
+   # Do stuff ...
+
+   close $LOGFILE if ($ARCH_DEBUG and defined($LOGFILE));
+   undef $root_filename ;
+
+   return $ArchError ;
+}
+
+
+################################################################################
+#
+# Init
+#
+################################################################################
+sub init() {
+
+   &logThis("");
+   &logThis("**********************************************");
+   &logThis("************** NEW LOAD REQUEST **************");
+   &logThis("**********************************************");
+   &logThis("");
+   &logThis(&get_current_time);
+
+   # test input files
+   $pdf_filename = $root_filename . ".pdf";
+   $prt_filename = $root_filename . ".arch";
+   return &ArchDie("$pdf_filename does not exist !") unless (-e $pdf_filename);
+   return &ArchDie("$prt_filename does not exist !") unless (-e $prt_filename);
+
+   &logThis("root_filename is $root_filename");
+   &logThis("pdf_filename is $pdf_filename");
+   &logThis("prt_filename is $prt_filename");
+}
+
+
+################################################################################
+#
+# Logs to syslog and also to file if debug mode
+#
+################################################################################
+sub logThis() {
+    my $msg = shift ;
+    local $\ = "\n" ;
+    &Debug(split(/\n/,$msg)) if ( length($msg) and ! $ArchError );
+    print $LOGFILE "[" . &format_date . "] " . $msg
+        if ($ARCH_DEBUG and defined($LOGFILE));
+}
+
+
+################################################################################
+#
+# Formats date
+#
+################################################################################
+sub format_date() {
+  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
+  return sprintf "%02d.%02d.%04d %02d:%02d:%02d",$mday,($mon+1),($year+1900),$hour,$min,$sec;
+}
+
+
+################################################################################
+#
+# Chrono
+#
+################################################################################
+sub chrono() {
+  my $ref = shift @_ ;
+
+  my $t0 = new Benchmark;
+  eval($ref) ;
+  &ArchDie($@) if $@;
+  my $t1 = new Benchmark;
+  my $td = timediff($t1, $t0);
+  $ref =~ s/^&//;
+  &logThis("CHRONO $ref:".timestr($td));
+}
+
+
+################################################################################
+#
+# Display time
+#
+################################################################################
+sub get_current_time() {
+   my @Weekdays = ('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday');
+   my @Months = ('January', 'February', 'March', 'April', 'May', 'June', 'July', 'August', 'September', 'October', 'November', 'December');
+   my @Now = localtime(time());
+
+   my $Weekday = $Weekdays[$Now[6]];
+   my $Day = $Now[3];
+   my $MonthText = $Months[$Now[4]];
+   my $Month = $Now[4]+1;
+   $Month = "0$Month" if $Month < 10;
+   my $Year = $Now[5]+1900;
+
+   my $Hour = $Now[2];
+   my $Minute = $Now[1];
+   $Minute = "0$Minute" if $Minute < 10;
+   my $Second = $Now[0];
+   $Second = "0$Second" if $Second < 10;
+   return "$Weekday $Day $MonthText $Year $Hour:$Minute:$Second";
+}
+
+
+################################################################################
+#
+# Logs ArchDie functions
+#
+################################################################################
+
+sub id {
+   my $level = shift;
+   my($pack,$file,$line,$sub) = caller($level);
+   my($id) = $file=~m|([^/]+)$|;
+   return ($file,$line,$id);
+}
+
+sub stamp {
+   my $time = scalar(localtime);
+   my $frame = 0;
+   my ($id,$pack,$file);
+   do {
+      $id = $file;
+      ($pack,$file) = caller($frame++);
+   } until (!$file or $file eq $id);
+   ($id) = $id=~m|([^/]+)$|;
+   return "[$time] $id: ";
+}
+
+sub ArchDie {
+   &Debug("Archivage request dies");
+   my $message = shift;
+   my($file,$line,$id) = &id(1);
+   $message .= " at $file line $line.";
+   my $stamp = &stamp;
+   #$message =~ s/^/$stamp/gm;
+   &logThis("ERROR: $message") ;
+   &Error($message); # Syslog version
+   $ArchError ++ ;
+}
+
+################################################################################
+#
+# END
+#
+################################################################################
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
Index: /A2P/a2p/A2P/threads.pm
===================================================================
--- /A2P/a2p/A2P/threads.pm	(revision 3)
+++ /A2P/a2p/A2P/threads.pm	(revision 3)
@@ -0,0 +1,388 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+package A2P::threads;
+
+use strict ;
+use integer ;
+use UNIVERSAL 'isa' ;
+use Time::HiRes qw( usleep gettimeofday tv_interval ) ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use A2P::Signal ;
+use A2P::Com qw( IsCom comSAY );
+
+BEGIN {
+    use Exporter ();
+
+    our ( $VERSION , @ISA , @EXPORT , @EXPORT_OK );
+
+    $VERSION = sprintf "%s", q$Rev: 490 $ =~ /(\d[0-9.]+)\s+/ ;
+
+    @ISA = qw(Exporter);
+    @EXPORT = qw( %sons %sonname %SonKind %HasQuit @answers $started );
+    @EXPORT_OK = qw(
+        &THCountAll &THCountStopping &is_son &FromToDoCom &SetNewLogger
+        &ThreadsStarter &ThreadsChecker &CheckChildrenQuitTimeOut
+        &is_really_logger &threads_internal_updates &THList
+        &threadSleep &reduceSleep
+        );
+}
+our $VERSION ;
+
+#############################################################################
+##                 Declaration and vars update                             ##
+#############################################################################
+
+our %SonKind = ();
+
+# Sons/Threads and Quit status hash list, keys are processes PID
+our %sons ;
+our %sonname ;
+our %HasQuit ;
+my %LastRestart ;
+
+# Children answers list
+our @answers ;
+
+my $currentlogger = 0 ;
+our $started = 0 ;
+my $controlrestart = 0 ;
+my $restartcheck = [ &gettimeofday() ] ;
+
+# Should be called at any conf reload request by the parent
+sub threads_internal_updates {
+    %SonKind = (
+        #######################################################################
+        #                Thread Alias       Thread Factor
+        #######################################################################
+                    'JobManager'    =>  1,
+                    'SpoolManager'  =>  $SCAN_SPOOL ? 1 : 0,
+                    'Listener'      =>  1,
+                    'Logger'        =>  $START_LOGGER,
+                    'Converter'     =>  $MAXJOBS,
+                    'BackEnd'       =>  $MAXJOBS * $BACKEND_FACTOR,
+                    'Archiver'      =>  $ARCH_ENABLED < 100 ?
+                        $BACKEND_FACTOR * $ARCH_ENABLED : $BACKEND_FACTOR,
+                    'EService'      =>  $ESERVICE_ENABLED < 100 ?
+                        $BACKEND_FACTOR * $ESERVICE_ENABLED : $BACKEND_FACTOR
+
+        #######################################################################
+        );
+}
+
+&threads_internal_updates();
+
+#############################################################################
+##                 Exported tools used in any process                      ##
+#############################################################################
+my $SleepFactor = 1 ;
+
+sub threadSleep {
+    # Short sleep (USLEEP/2) when quitting
+    return usleep $USLEEP >> 1 if ($do_quit);
+
+    usleep $SleepFactor * $USLEEP ;
+
+    if ($DYNAMIC_USLEEP) {
+        &UPSTAT('LOOPS-SLEEP');
+        &UPSTAT('LOOPS-SKIPPED',$SleepFactor-1);
+
+        # Update SleepFactor and its monitoring
+        &MAXSTAT('SLEEP-FACTOR',++ $SleepFactor)
+            unless ( $SleepFactor * $USLEEP >= $MAX_DYNAMIC_USLEEP );
+    }
+}
+
+sub reduceSleep {
+    return unless ( $DYNAMIC_USLEEP and $SleepFactor > 1 );
+
+    # Keep stats on SleepFactor when it has grown, unless called with any value
+    &UPSTAT('MAXSLEEPFACTOR-REACHED-'.$SleepFactor) unless @_ ;
+
+    # Decrease rapidly SleepFactor by binary division until reach 1
+    # Greater than 4, we divide by 2^2=4 else by 2^1=2
+    $SleepFactor >>= $SleepFactor > 4 ? 2 : $SleepFactor > 1 ;
+}
+
+#############################################################################
+##                 Exported tools used in parent                           ##
+#############################################################################
+
+# Thread check mini subs
+sub THList {
+    return grep { $sons{$_}->is($_[0]) } keys(%sons) ;
+}
+
+sub THAlive {
+    return grep { ! $HasQuit{$_} } &THList($_[0]) ;
+}
+
+sub THCountAll {
+    return scalar(grep { ! $sons{$_}->StoppingSince() } keys(%sons));
+}
+
+sub THCountStopping {
+    return scalar(grep {   $sons{$_}->StoppingSince() } keys(%sons));
+}
+
+sub is_son {
+    return 0 unless (defined($sons{$_[0]}));
+    ref($sons{$_[0]}) =~ /^A2P::(.*)$/ ;
+    return defined($1) ? defined($SonKind{$1}) : 0 ;
+}
+
+sub is_really_logger {
+    return &is_son($_[0]) and $sons{$_[0]}->is('Logger') ;
+}
+
+sub FromToDoCom {
+    my $reqid   = shift ;
+    my $kind    = shift ;
+    my @threads = $kind =~ /^\d+$/ ? ( $kind ) : &THAlive($kind) ;
+
+    &Error("No such $kind thread for a request")
+        unless @threads ;
+
+    # Find one available thread to do the request
+    while ( @threads ) {
+        my $chance = int(rand(@threads));
+        my $thread = shift @threads ;
+        if ($chance) {
+            # Choose randomly which process to try to not send request to the
+            # same free process
+            push @threads, $thread ;
+            next ;
+        }
+
+        my $requester = $sons{$thread}->isBusyBy() ;
+        if ($requester) {
+            &Debug($sonname{$thread} . " still busy by " . $sonname{$requester},
+                "Business is on '" . $sons{$thread}->getBusyReq() . "'");
+
+        } else {
+            # We don't want to busy JobManager and Listener unless by parent
+            $reqid = 0 if ( $reqid != $$ and
+                ($sons{$thread}->is('JobManager','Listener')));
+
+            # Keep who generate the request to return next answer
+            $sons{$thread}->setBusy( $reqid , @_ )
+                unless ( ! $reqid or &IsCom( comSAY , $_[0] ));
+
+            $sons{$thread}->AskThread( TODO , @_ );
+
+            &Debug("Request transmitted to " . $sonname{$thread});
+            return 1 ;
+        }
+    }
+
+    return 0 ;
+}
+
+sub SetNewLogger {
+    # Argument can be < 0 to initialize logger with current logger thread
+    $loggertid = shift if @_ ;
+    ( $loggertid ) = &THList('Logger') if ( $loggertid < 0 );
+    return $loggertid if ( $loggertid == $currentlogger );
+
+    &SetLogger( $sons{$loggertid} );
+    map { $sons{$_}->SwitchLogger( $loggertid ) } keys(%sons) ;
+    $currentlogger = $loggertid ;
+}
+
+#############################################################################
+##                 Thread starter and checker code                         ##
+#############################################################################
+sub ThreadsStarter {
+    my $Sub  = shift ;
+    my $debug = $_[0] ? shift : 0 ;
+
+    my $MaxTask = $MAXTASK * $SonKind{$Sub} ;
+    my $Object = 'A2P::' . $Sub ;
+
+    &Debug("Launching starter with sub '$Sub' and $MaxTask tasks");
+
+    &Debug("Starting $MaxTask $Object thread") if ( $debug and $MaxTask );
+
+    # Start threads if not enough threads are started
+    if ( &THList($Sub) < $MaxTask ) {
+
+        while ( &THList($Sub) < $MaxTask ) {
+
+            &Debug("Creating new $Object thread object");
+
+            my $Child = new $Object ;
+
+            if ( &isa( $Child ,$Object )) {
+                &Debug("$Child created");
+
+            } else {
+                &Error("Can't create $Object thread object");
+                last ;
+            }
+
+            if ( $Child->init() ) {
+
+                my $Tid = $Child->Fork();
+
+                if (defined($Tid)) {
+                    &Debug("$Sub thread started with TID $Tid");
+
+                    $sons{$Tid} = $Child ;
+                    $sonname{$Tid} = $Child->getName ;
+                    $HasQuit{$Tid} = 0 ;
+
+                } else {
+                    &Error("Can't start $Sub thread");
+                    last ;
+                }
+
+            } else {
+                &Error("Can't initialize $Sub thread");
+                last ;
+            }
+        }
+
+    # Or ask threads to check if one can quit
+    } elsif ( &THList($Sub) > $MaxTask ) {
+        my @Childs = &THList($Sub) ;
+        my $count  = scalar(@Childs) - $MaxTask ;
+        while ( $count -- ) {
+            my $child = shift @Childs ;
+
+            &Debug("Asking T$child $Sub thread to stop");
+            $sons{$child}->AskToStop();
+            &SetNewLogger(0) if ( $sons{$child}->getKind() =~ /logger/i );
+            $sonname{$child} .= '*' ;
+            $HasQuit{$child} = $sonname{$child} ;
+        }
+
+    # Or we are checking a thread kind as it can be dead
+    } elsif ($MaxTask) {
+        foreach ( &THList($Sub) ) {
+            $sons{$_}->Delete()
+                unless $sons{$_}->isAlive() ;
+        }
+        &Debug("Still have the right number ($MaxTask) of $Sub thread")
+            if ( &THList($Sub) == $MaxTask );
+    }
+    my @list = &THAlive($Sub) ;
+    &Debug( scalar(@list) . " $Object thread started") if ( $debug and $MaxTask );
+    return @list ;
+}
+
+sub ThreadsChecker {
+    my $Err = 0 ;
+
+    # Update SpoolManager need if necessary
+    if ( $SonKind{SpoolManager} != $SCAN_SPOOL ) {
+        &Debug(($SCAN_SPOOL ? "Activating"  : "Suspending") . " SpoolManager thread");
+        $SonKind{SpoolManager} = $SCAN_SPOOL ;
+    }
+
+    foreach my $kind ( @_ ? @_ : keys(%SonKind) ) {
+        my $need = $MAXTASK * $SonKind{$kind} ;
+        my $todo = $need - &THAlive($kind) ;
+        if ( $todo ) {
+            my $nextmessage ;
+            if ( $todo < 0 ) {
+                &Debug("Shutting down " . abs($todo) . " $kind threads to reach $need");
+                $nextmessage = "Failed to stop threads" ;
+
+            } else {
+                &Alert("Restarting $todo $kind threads to reach ".($need>1?"$need ones":"one"));
+                $nextmessage = "Failed to start threads" ;
+                $controlrestart ++ ;
+                if (&tv_interval($restartcheck) >= 2 ) {
+                    if ( $controlrestart > 5 ) {
+                        &Alert("Stopping service as too much process restart ($controlrestart>5) occurs in the last 2 sec");
+                        $MUSTQUIT ++ ;
+                    }
+                    $controlrestart = 0 ;
+                    $restartcheck = [ &gettimeofday() ] ;
+                }
+            }
+
+            # Don't try again to start a process too quickly
+            if (defined($LastRestart{$kind})) {
+                unless ( &tv_interval($LastRestart{$kind}) >= 5 ) {
+                    &Debug("Will delay the start of $kind thread");
+                    next ;
+                }
+                &Debug("Previous $kind thread was started " .
+                    &tv_interval($LastRestart{$kind}) . " sec ago");
+            }
+            $LastRestart{$kind} = [ &gettimeofday() ];
+
+            my $count = &ThreadsStarter( $kind );
+            # Try again one time as first call could have only clean the hash
+            $count = &ThreadsStarter( $kind ) unless ( $count == $need );
+            unless ( $count == $need ) {
+                &Warn($nextmessage) ;
+                &Warn("Only " . &THAlive($kind) . " threads are availables");
+                $Err ++ ;
+            }
+        }
+    }
+    return $Err ? 0 : 1 ;
+}
+
+my ( $firstcheck , $lastcheck ) = ( [ &gettimeofday() ] , [ ] );
+sub CheckChildrenQuitTimeOut {
+
+    if ( @{$lastcheck} or &tv_interval($firstcheck) >= 1 ) {
+        if ( @{$lastcheck} and &tv_interval($lastcheck) >= 1 ) {
+            &Debug((&THCountAll + &THCountStopping) .
+                " childrens seems to be alive since " . &tv_interval($firstcheck));
+            $lastcheck = [ &gettimeofday() ];
+
+        } elsif ( ! @{$lastcheck} ) {
+            $firstcheck = [ &gettimeofday() ];
+            $lastcheck = [ &gettimeofday() ];
+        }
+    }
+
+    map {
+        if ( ! $HasQuit{$_} and $sons{$_}->isAlive() ) {
+            if ($sons{$_}->SendSigTerm()) {
+                &Debug("Sending SIGTERM to children T$_");
+
+            } elsif ($sons{$_}->SendSigKill()) {
+                &Debug("Sending SIGKILL to children T$_");
+                $sons{$_}->Delete() ;
+                $sonname{$_} .= '+' ;
+                $HasQuit{$_} = $sonname{$_} ;
+            }
+
+        } else {
+            &Debug("Children T$_ has leaved now");
+            push @answers , $sons{$_}->getAnswers() ;
+            $sons{$_}->Delete() ;
+            $sonname{$_} .= '+' ;
+            $HasQuit{$_} = $sonname{$_} ;
+        }
+    } keys(%sons) ;
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
Index: /A2P/a2p/AFPDS/ControlRecord.pm
===================================================================
--- /A2P/a2p/AFPDS/ControlRecord.pm	(revision 3)
+++ /A2P/a2p/AFPDS/ControlRecord.pm	(revision 3)
@@ -0,0 +1,706 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Class to implement Control Record Object object
+
+package AFPDS::ControlRecord;
+
+use strict;
+use Encode 'from_to';
+use A2P::XML ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use A2P::Tools qw( mychomp ShortID ) ;
+use AFPDS::ControlRecordDef ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 934 $ =~ /(\d[0-9.]+)\s+/ ;
+}
+our $VERSION ;
+
+# Variables exported from AFPDS::ControlRecordDef module :
+# %RCDEF
+# %SIZE
+
+# Splitter control
+my $LastSplitControl = undef ;
+
+sub new {
+    &Debug("new AFPDS::ControlRecord v$VERSION");
+    my $class = shift ;
+
+    # Default is to generate a PDF file and valid for archivage
+    my $self = {
+        TYPE    =>  shift , TEXBASE   =>  shift , AFPNAME  =>  shift ,
+        AFPNUM  =>  shift , ISPRINT   =>  0     , ERROR    =>  []
+    };
+
+    # Set some other defaults
+    map { $self->{$_} = "" } qw(
+        DO_PDF DO_LPR  DO_PS    DVILJOPT JOBNAME   LPROPT DVIPSOPT
+        DO_PCL DO_VLPR DO_ARCH VDVILJOPT OUTFILE  VLPROPT
+        );
+
+    if ( !defined( $RCDEF{$self->{TYPE}} ) ) {
+        &Error("Unknown Control Record type '$self->{TYPE}'");
+        return undef ;
+    }
+
+    if ($SIZE{$self->{TYPE}}>0)  {
+        &Debug("ControlRecord type '$self->{TYPE}' should be max " .
+            $SIZE{$self->{TYPE}} . " bytes long with header (5 bytes)");
+
+    } elsif ($SIZE{$self->{TYPE}}<0)  {
+        &Debug("ControlRecord type '$self->{TYPE}' is a not sized RC");
+    }
+
+    # Reset known tags if we are starting a new job
+    if ( $self->{AFPNUM} == 1 ) {
+        &Debug("First ControlRecord for a new job, resetting control");
+        $LastSplitControl = undef ;
+    }
+
+    return bless $self , $class ;
+}
+
+my $job_tag = "" ;
+sub job_tag {
+    my $self = shift ;
+    return @_ ? $job_tag = "$_[0]: " : $job_tag ;
+}
+
+sub init {
+    my $self = shift ;
+    $self->{BUFFER} = shift ;
+    &mychomp( \$self->{BUFFER} );
+
+    &Debug("Initializing new Record type '$self->{TYPE}'");
+
+    my $CurrentRCSize = length($self->{BUFFER}) + 5 ;
+    &Debug("Type = $self->{TYPE}, RCLength = " . $CurrentRCSize );
+
+    # Initialize any value defined in 'new' member replacing the
+    # definition array reference by the real value
+    for my $key ( keys(%{$RCDEF{$self->{TYPE}}}) ) {
+        # Check if key is a splitter code
+        if ( $key =~ /^__A2P_SPLITTER__$/ ) {
+            &Debug("Type = $self->{TYPE}, RC{$key} : splitter loaded");
+            $self->{$key} = $RCDEF{$self->{TYPE}}->{$key} ;
+            next ;
+        }
+
+        my ( $pos , $size ) = @{$RCDEF{$self->{TYPE}}->{$key}} ;
+
+        # Only handle RC size if it's a sized defined RC
+        if (defined($size) and $size>0) {
+            &Debug("Extracting value @ $pos + $size");
+            $self->{$key} = $self->value( $pos , $size );
+
+            return $self->ABTERM( 301,
+                "Can't read $key value at pos $pos, $size long" )
+                unless (defined($self->{$key}));
+
+            &Debug("Type = $self->{TYPE}, RC{$key} = '$self->{$key}'");
+        }
+    }
+
+    if ( $self->{TYPE} =~ /^(100|001)$/ ) {
+        # Control record 001 or 100 specific initialization
+
+        # Update specific values
+        $self->{ISPRINT} = $self->{TYPE} =~ /^100$/ ? 0 : 1 ;
+
+        # We force DO_PDF to 'yes' if not a print as we have no info on it
+        # DO_ARCH will be updated only if a RC 101 is also provided
+        if ( $self->{TYPE} =~ /^100$/ ) {
+            $self->{DO_PDF}  = 'yes' ;
+            $self->{DO_ARCH} =  'no' ;
+        }
+
+        # Strip spaces at end of values
+        $self->{PAGEDEF} =~ s/\s+$// ;
+        $self->{FORMDEF} =~ s/\s+$// ;
+        $self->{CHARS}   =~ s/\s+$// ;
+        $self->{FLASH}   =~ s/\s+$// if ($self->{ISPRINT});
+        $self->{DESTID}  =~ s/\s+$// if ($self->{ISPRINT});
+        $self->{DOCNAME} =  $self->{IMPDOCA} . $self->{IMPDOCN} ;
+
+        # This should be help to link linux job to mainframe job
+        $self->{JOBNAME} = $self->{AFPNAME} . '-' . $self->{UTISTE3} . '_' .
+            $self->{UTIPRJ} . $self->{DOCNAME} . '-AFP' . $self->{AFPNUM};
+
+        $self->{TEXBASE} .= '/AFP-' . $self->{AFPNUM} ;
+
+        # Here make a folder for TEXBASE or rise an ABTERM
+        return $self->ABTERM( 302,
+            "Can't create " . $self->{TEXBASE} . " folder: $!" )
+            unless ( mkdir $self->{TEXBASE} , 0775 );
+
+        # OUTFILE is a critical value for all threads
+        $self->{OUTFILE} = $self->{TEXBASE} . '/' .
+            ( $self->{TYPE} =~ /^100$/ ? 'archive' : 'print' ) ;
+
+        if ($self->{ISPRINT}) {
+            # Force DESTID if required in conf
+            if ($FORCE_DESTID) {
+                &Debug("Force Destination '$self->{DESTID}' to $FORCE_DESTID");
+                $self->{DESTID} = $FORCE_DESTID ;
+            }
+
+            # Read Destination configuration file to set needed options
+            my $xml = $self->getxml();
+            return $self->ABTERM( 303,
+                "Can' get an XML object to handle DESTID conf" )
+                unless (defined($xml));
+
+            # Leave if DestId file does not exist
+            return $self->ABTERM( 304, "'$DESTIDFILE' XML conf doesn't exist" )
+                unless ( -e $DESTIDFILE );
+
+            &Debug("Parsing XML configuration file '$DESTIDFILE'");
+            return $self->ABTERM( 305, "Can't read DESTID conf" )
+                unless ( $xml->parse_file( $DESTIDFILE ) eq $DESTIDFILE );
+
+            # This selectDestId API selects a node on which we will 'get' values
+            return $self->ABTERM( 306,
+                "No printer configuration found for DestID '$self->{DESTID}'")
+                unless ($xml->selectDestId($self->{DESTID}) eq $self->{DESTID});
+
+            &Debug("'$self->{DESTID}' printer configuration selected");
+            $self->{DO_PCL}    = $xml->get( 'PCL'  );
+            $self->{DO_PS}     = $xml->get( 'PS'   );
+            $self->{DO_LPR}    = $xml->get( 'LPR'  );
+            $self->{DO_VLPR}   = $xml->get( 'VLPR' );
+            $self->{DO_PDF}    = $xml->get( 'PDF'  );
+            $self->{DO_ARCH}   = $xml->get( 'ARCH' );
+            $self->{DVILJOPT}  = $xml->get( 'DVILJOptions' );
+            $self->{DVIPSOPT}  = $xml->get( 'DVIPSOptions' );
+            $self->{LPROPT}    = $xml->get( 'LPROptions'   );
+            $self->{VLPROPT}   = $xml->get( 'VLPROptions'  );
+            $self->{VDVILJOPT} = $xml->get( 'VDVILJOptions' );
+
+            # Check also if we should check to adapt document or not
+            my $can_do_correction = $xml->get( 'ByDocumentCorrection' ) ;
+
+            # Set default from service configuration if not defined
+            $can_do_correction = $DOCUMENTS_CORRECTION_ENABLED
+                unless (defined($can_do_correction)
+                and $can_do_correction =~ /^\d+$/);
+
+            # Is correction forced by service configuration ?
+            $can_do_correction ++
+                if ($DOCUMENTS_CORRECTION_ENABLED > 1 );
+
+            # Reset to default 'no' if a value is not defined
+            map { $self->{$_} = "no" } grep { ! defined($self->{$_}) } qw(
+                    DO_PCL DO_PS DO_PDF DO_LPR DO_VLPR
+                    );
+
+            # Reset to default "(nothing)" if a value is not defined
+            map { $self->{$_} = "" } grep { ! defined($self->{$_}) } qw(
+                    DVILJOPT DVIPSOPT LPROPT VLPROPT VDVILJOPT
+                    );
+
+            &Debug("'$self->{DESTID}' configuration read");
+
+            my $hasconf = 1 ;
+            # Forced in service configuration
+            if ($DONT_PRINT) {
+                &Info(job_tag."Printing disabled in conf");
+                $self->{DO_LPR}  = 'no' ;
+                $self->{DO_VLPR} = 'no' ;
+
+            } elsif ( $hasconf = $self->getdocsconf($self->{DOCNAME})
+            and $can_do_correction ) {
+                &Debug("Have a correction for document " . $self->{DOCNAME} .
+                    " to apply");
+                # If a correction is defined for the current document, we need
+                # to update DVILJOptions and VDVILJOptions
+                $self->fixdviljconf($self->{DOCNAME});
+
+            } elsif ($hasconf eq $self->{DOCNAME} and ! $can_do_correction) {
+                &Info(job_tag."'$self->{DOCNAME}' Document corrections " .
+                    "discarded for this DestID");
+
+            } elsif (!$hasconf) {
+                &Debug("No correction for '$self->{DOCNAME}' Document in conf");
+            }
+
+            ################################
+            # Bin/tray support
+            ################################
+            # Extract values
+            $self->{DVILJOPT}  =~ /\-T1=(\d+).*\-T2=(\d+)/ ;
+            my ( $TA , $TB ) = ( $1 , $2 );
+            $self->{VDVILJOPT}  =~ /\-T1=(\d+).*\-T2=(\d+)/ ;
+            my ( $VTA , $VTB ) = ( $1 , $2 );
+
+            # Set to default auto-select value 7 if not defined
+            my $not_defined = 0;
+            map { $$_ = 7 , $not_defined++ if (!defined($$_)) }
+                (\$TA,\$TB,\$VTA,\$VTB);
+            &Debug("Bin selection  A=$TA,  B=$TB");
+            &Debug("Bin selection VA=$VTA, VB=$VTB)");
+            &Info(job_tag."Found $not_defined not defined Bin-Tray selection")
+                if $not_defined ;
+
+            # Compute PCL5 command for bin/tray selection in file
+            # if not supported by dvi2pcl command
+            if (! $USE_PCLCMD) {
+                # Prepare PCL5 command files for insertion if needed
+                open(TRAYA, ">$self->{OUTFILE}.trayone")
+                    or &Error("Can't open $self->{OUTFILE}.trayone :$!");
+                print TRAYA  chr(27) . "&l" .  $TA . "H"
+                    if (defined(fileno( TRAYA)));
+                close(TRAYA);
+
+                open(TRAYB, ">$self->{OUTFILE}.traytwo")
+                    or &Error("Can't open $self->{OUTFILE}.traytwo :$!");
+                print TRAYB  chr(27) . "&l" .  $TB . "H"
+                    if (defined(fileno( TRAYB)));
+                close(TRAYB);
+
+                if ( $TA != $VTA ) {
+                    open(VTRAYA, ">$self->{OUTFILE}.vtrayone")
+                        or &Error("Can't open $self->{OUTFILE}.vtrayone :$!");
+                    print VTRAYA chr(27) . "&l" .  $VTA . "H"
+                        if (defined(fileno(VTRAYA)));
+                    close(VTRAYA);
+                }
+
+                if ( $TB != $VTB ) {
+                    open(VTRAYB, ">$self->{OUTFILE}.vtraytwo")
+                        or &Error("Can't open $self->{OUTFILE}.vtraytwo :$!");
+                    print VTRAYB chr(27) . "&l" .  $VTB . "H"
+                        if (defined(fileno(VTRAYB)));
+                    close(VTRAYB);
+                }
+
+                # Strip DVIJLOptions from any Tray/bin definition...
+                $self->{DVILJOPT}  =~ s/\-T.*// ;
+                $self->{VDVILJOPT} =~ s/\-T.*// ;
+            }
+
+        } #endif $self->{ISPRINT}
+
+    } elsif ( $self->{TYPE} =~ /^101$/ ) {
+        # We could only transmit job to archiver when we have found a 101 record
+        ( $self->{DO_PDF} , $self->{DO_ARCH} ) = ( 'yes' , 'yes' );
+    }
+    &Debug("Initialization done");
+}
+
+sub can_split_job {
+    my $self = shift ;
+    return 0 unless $ENABLE_SPLITTER ;
+
+    # Control auto-splitter first
+    return 1 if ( $AUTO_SPLIT_MAX and $self->{AFPNUM} > $AUTO_SPLIT_MAX );
+
+    return 0 unless (defined($self->{__A2P_SPLITTER__}));
+
+    my $splitter = $self->{__A2P_SPLITTER__} ;
+    my $control = &$splitter( $self );
+
+    if (defined($LastSplitControl)) {
+        # Just compare if the value returned by splitter has changed
+        unless ( $control =~ /^$LastSplitControl$/ ) {
+            &Info(job_tag."Splitting AFPDS between jobs for " .
+                $LastSplitControl . " and " . $control );
+
+            # Keep last control as tag if desired
+            $self->{SPLIT_TAGS} = [ $LastSplitControl, $control ] ;
+            $LastSplitControl = $control;
+
+            &UPSTAT('SPLIT_EVENT');
+
+            return 1 ;
+        }
+
+    } else {
+        # First time just initialize the control handler
+        $self->{SPLIT_TAGS} = [ $LastSplitControl = $control ] ;
+    }
+
+    # Return false by default
+    return 0
+}
+
+sub get_split_tags {
+    my $self = shift ;
+
+    # Clean RC initialization to avoid agregation conflicts
+    rmdir $self->{TEXBASE} ;
+
+    # Try to return uniq tags list or return a tag couple which must be
+    # automatically updated in JobManager
+    return (defined($self->{SPLIT_TAGS}) and @{$self->{SPLIT_TAGS}} > 1 ) ?
+        @{$self->{SPLIT_TAGS}} : ( 'PART', 'PART' );
+}
+
+my $XMLCONF ;
+sub getxml {
+    my $self = shift ;
+
+    # Get cached A2P::XML object as it is used here to only read Destid conf
+    return $XMLCONF
+        if (defined($XMLCONF) and ref($XMLCONF) =~ /^A2P::XML$/ );
+
+    &Debug("Creating new XML object to handle DESTID configuration");
+    return $XMLCONF = new A2P::XML ;
+}
+
+my $DOCSCONF ;
+sub getdocsconf {
+    my $self = shift ;
+    my $doc  = shift ;
+
+    unless ( -e $DOCSFILE ) {
+        &Info(job_tag."'$DOCSFILE' Documents corrections configuration " .
+            "not found, skipping");
+        return 0 ;
+    }
+
+    unless (defined($doc) and $doc) {
+        &Warn("No document specified while checking documents configuration");
+        return 0 ;
+    }
+
+    # Get cached A2P::XML object as it is used here to only read documents conf
+    unless (defined($DOCSCONF) and ref($DOCSCONF) =~ /^A2P::XML$/ ) {
+        &Debug("Creating new XML object to handle DOCUMENTS configuration");
+        $DOCSCONF = new A2P::XML ;
+    }
+
+    &Debug("Parsing XML configuration file '$DOCSFILE'");
+    unless ( $DOCSCONF->parse_file( $DOCSFILE ) eq $DOCSFILE ) {
+        &Warn("Can't read $DOCSFILE documents conf, won't apply correction");
+        return 0 ;
+    }
+
+    unless( $DOCSCONF->selectDocument($doc) eq $doc ) {
+        &Debug("Document '$doc' not defined in documents table");
+        return 0 ;
+    }
+
+    return $doc ;
+}
+
+sub fixdviljconf {
+    my $self = shift ;
+    my $doc  = shift ;
+
+    unless (defined($doc) and $doc) {
+        &Warn("No document specified while updating print");
+        return 0 ;
+    }
+
+    # Check target to know what to update, by default 1 -> update all
+    my $target = $DOCSCONF->getAttribute('target');
+    $target = 1 unless (defined($target) and $target =~ /^[0-2]$/);
+
+    my @toupdate = $target<2 ? ( 'DVILJOPT' ) : () ;
+    push @toupdate, 'VDVILJOPT' if ($target>0);
+
+    # Check to update magnication (or scaling)
+    my $scale = $DOCSCONF->getAttribute('scale');
+    if (defined($scale) and $scale !~ /^(100%|1000)$/ and $scale =~ /^(\d+)/) {
+        my ( $rawscale ) = $scale =~ /^(\d+)/ ;
+        # If we have a rate, we need to set magnication toward 1000 as 100%
+        $rawscale *= 10 if ($scale =~ /%/);
+
+        &Debug("Adjusting scaling with '$scale' value (raw=$rawscale)");
+
+        $self->{DVILJOPT}  .= ' -m#' . $rawscale if ($target<2);
+        $self->{VDVILJOPT} .= ' -m#' . $rawscale if ($target>0);
+
+    } else {
+        &Debug("No scaling defined for document '$doc'");
+    }
+
+    # Check to update mode
+    my $mode = $DOCSCONF->getAttribute('mode');
+    $mode = 1 unless (defined($mode) and $mode =~ /^[0-2]$/);
+    foreach my $option ( @toupdate ) {
+        &Debug("Trying to update mode in '$option' options");
+        if ( $mode == 0 and $self->{$option} =~ /-O\d\s*/ ) {
+            # For mode normal, we just need to erase any -O option
+            &Debug("Setting mode Normal on '$option' options");
+            $self->{$option} =~ s/-O\d\s*// ;
+
+        } elsif ($mode == 1 and $self->{$option} !~ /-O1\s*/ ) {
+            &Debug("Setting mode Advanced on '$option' options");
+            $self->{$option} =~ s/-O\d\s*/-O1 / ;
+            $self->{$option} .= " -O1" unless ($self->{$option} =~ /-O1\s*/);
+
+        } elsif ($mode == 2 and $self->{$option} !~ /-O2\s*/ ) {
+            &Debug("Setting mode Advanced on '$option' options");
+            $self->{$option} =~ s/-O\d\s*/-O2 / ;
+            $self->{$option} .= " -O2" unless ($self->{$option} =~ /-O2\s*/);
+        }
+    }
+
+    my @offset = ( $DOCSCONF->getAttribute('x') , $DOCSCONF->getAttribute('y'));
+    if (@offset and defined($offset[0]) and defined($offset[1]) and
+        $offset[0] =~ /^[0-9.+-]+$/ and $offset[1] =~ /^[0-9.+-]+$/ and
+        ($offset[0] or $offset[1]))
+    {
+        # Apply corrections
+        foreach my $option ( @toupdate ) {
+            &Debug("Trying to update off-set in '$option' options");
+
+            # Apply X correction
+            if ( $offset[0] and $self->{$option} =~ /-x([0-9.+-]+)/ ) {
+                my $new = $offset[0] + $1 ;
+                &Debug("Updating $1 x off-set with $new on '$option' options");
+                $self->{$option} =~ s/-x([0-9.+-]+)/-x$new/ ;
+
+            } elsif ($offset[0]) {
+                &Debug("Setting x off-set to $offset[0] on '$option' options");
+                $self->{$option} .= ' -x' . $offset[0] ;
+
+            } else {
+                &Debug("No x-offset update required on '$option' options");
+            }
+
+            # Apply Y correction
+            if ($offset[1] and $self->{$option} =~ /-y([0-9.+-]+)/) {
+                my $new = $offset[1] + $1 ;
+                &Debug("Updating $1 y off-set with $new on '$option' options");
+                $self->{$option} =~ s/-y([0-9.+-]+)/-y$new/ ;
+
+            } elsif ($offset[1]) {
+                &Debug("Setting y off-set to $offset[1] on '$option' options");
+                $self->{$option} .= ' -y' . $offset[1] ;
+
+            } else {
+                &Debug("No y-offset update required on '$option' options");
+            }
+        }
+
+    } else {
+        &Debug("No offset correction defined for document '$doc'");
+    }
+}
+
+sub save_a2pxml_file {    # RC 200/201
+    my $self = shift ;
+    my $file = shift || "" ;
+    my ( $ret , $msg ) = ( 0 , "No content saved" );
+
+    open XML, ">$file"
+        or return &Error("Can't open '$file' XML file for writing: $!");
+
+    if ( $self->{TYPE} =~ /^200$/ and defined($self->{XML})) {
+        $ret = print XML $self->{XML}->toString ;
+
+    } elsif ( $self->{TYPE} =~ /^201$/ ) {
+        $ret = print XML map { $$_ } @{$self->{LINES}} ;
+
+    } else {
+        $msg = "No content to save" ;
+    }
+
+    close(XML);
+
+    return $ret ?
+        $ret : &Error( $msg . " for Control Record type '$self->{TYPE}'" ) ;
+}
+
+sub set_a2p_attribut {  # RC 200
+    my $self  = shift ;
+    my $name  = shift || "" ;
+    my $value = shift || "" ;
+
+    return 0 unless (defined($self->{XML}) and $name and $value);
+
+    return $self->{XML}->set_a2p_attribut( $name , $value );
+}
+
+sub seta2pxml {        # RC 200
+    my $self = shift ;
+    my $line = shift || "" ;
+    my $file = shift || "" ;
+
+    &Warn("Overiding still different defined output file for A2P XML content")
+        if ( $self->{OUTFILE} and $self->{OUTFILE} !~ /^$file$/ );
+
+    # Keep base filename
+    $self->{OUTFILE} = $file ;
+
+    my $XML ;
+    if (defined($self->{XML})) {
+        $XML = $self->{XML} ;
+
+        &Debug("Concatenate XML with '$line'");
+        $XML->concatenate($line . "\n");
+
+    } else {
+        &Debug("Creating new XML with '$line'");
+        $XML = new A2P::XML(\$line);
+    }
+
+    $self->{XML} = $XML ;
+}
+
+sub addcontentref {      # RC 201
+    my $self = shift ;
+
+    if (defined($self->{LINES})) {
+        push @{$self->{LINES}}, @_ ;
+
+    } else {
+        $self->{LINES} = [ @_ ] ;
+    }
+}
+
+sub a2pxml_is_valid {    # RC 200
+    my $self = shift ;
+    return 0 unless (defined($self->{XML}));
+
+    # Check <a2p /> is valid and save the name it returns as e-service name
+    return $self->{'E-SERVICE'} = $self->{XML}->isA2P_eService() ;
+}
+
+sub ABTERM {
+    my $self = shift ;
+    @{$self->{ERROR}} = @_ ;
+    &Error($self->{ERROR}->[1]);
+    return - $self->{ERROR}->[0] ;
+}
+
+sub getbase {
+    return $_[0]->{TEXBASE} ;
+}
+
+sub geterror {
+    return @{$_[0]->{ERROR}} ;
+}
+
+sub value {
+    my ( $self , $pos , $len ) = @_ ;
+    # Index 0 in buffer is the Pos 6 of the control record specification
+    $pos -= 6 ;
+    my $buf = substr( $self->{BUFFER} , $pos , $len ) ;
+    &from_to( $buf , $FROM_CONVERT , $TO_CONVERT ) if ($DO_CONVERT);
+    return $buf ;
+}
+
+sub getRecord {
+    # Return only the Record for record type 100, 101, 102 & 103
+    return
+        $_[0]->{TYPE} < 100 ? "" : '#' . $_[0]->{TYPE} . '#' . $_[0]->{RECORD} ;
+}
+
+sub getenv {
+    my $self = shift ;
+
+    my $RCENV = {} ;
+
+    map {
+            if ( defined($self->{$_})? $self->{$_} : 0 ) {
+                $RCENV->{$_} = $self->{$_} ;
+                &Debug("Returning RCENV->$_: '$RCENV->{$_}'");
+            }
+        } qw(
+            OUTFILE  JOBNAME   COPIES   FORM    DESTID  IMPCLAS  DOCNAME
+            FLASH    CHARS     PAGEDEF  FORMDEF HOLD    PRIORITY BURST
+            DO_PDF   DO_ARCH   AFPNAME  DO_PCL  DO_PS   DO_LPR   DO_VLPR
+            DVILJOPT VDVILJOPT DVIPSOPT LPROPT  VLPROPT BIN      VBIN
+            );
+
+    # Return ISPRINT for statistics
+    if ( defined($self->{ISPRINT})) {
+        $RCENV->{ISPRINT} =  $self->{ISPRINT} ;
+        &Debug("Returning RCENV->ISPRINT: '$RCENV->{ISPRINT}'");
+    }
+
+    return $RCENV ;
+}
+
+sub getTRCforTeX {
+    my $self = shift ;
+    my ( $FONT , $font , $TeXCode , $i ) = ( "" , "" , "" , 0 ) ;
+
+    while ( $i < length($self->{CHARS}) ) {
+        $FONT = substr( $self->{CHARS} , $i , 4 );
+        ( $font = $FONT ) =~ tr/a-z0-9/A-Za-j/ ;
+
+        $TeXCode .= "\\let\\FONtTrc" . chr( 65 + ( $i >> 2 ) ) . "=\\Font" .
+                    $font . "% TRC{" . eval( $i >> 2 ) . "} set to $FONT\n";
+        $i += 4 ;
+    }
+    return $TeXCode ;
+}
+
+sub get_required_size {
+    my $self = shift ;
+    # Index 0 in buffer is the Pos 6 of the control record specification
+    # so we must substract 5 to requested size
+    return $SIZE{$self->{TYPE}} - 5 ;
+}
+
+sub getoutfile {
+    my $self = shift ;
+    &Debug("OUTFILE value = $self->{OUTFILE}");
+    return $self->{OUTFILE} ;
+}
+
+sub getpagedef {
+    my $self = shift ;
+    &Debug("PAGEDEF value = $self->{PAGEDEF}");
+    return $self->{PAGEDEF} ;
+}
+
+sub getformdef {
+    my $self = shift ;
+    &Debug("FORMDEF value = $self->{FORMDEF}");
+    return $self->{FORMDEF} ;
+}
+
+sub ispcloutput {
+    my $self = shift ;
+    return 0 if (!defined($self->{ISPRINT}) or !defined($self->{DO_PCL}));
+    return $self->{ISPRINT} ? ( $self->{DO_PCL} =~ /^yes$/i ? 1 : 0 ) : 0 ;
+}
+
+sub DESTROY {
+    my $self = shift;
+    my @err  = @{$self->{ERROR}} ;
+
+    # Free arrays memory
+    map { $self->{$_} = () if (ref($self->{$_}) eq 'ARRAY' ) } keys(%{$self});
+
+    if (@err) {
+        &UPSTAT('GET-RC-ERROR');
+        &UPSTAT('GET-RC-ERROR-' . $err[0] );
+        &Debug("ControlRecord object $self->{JOBNAME} destroyed with error #" .
+            $err[0]);
+
+    } else {
+        &UPSTAT('GOT-GOOD-RC');
+        &Debug("ControlRecord object $self->{JOBNAME} destroyed");
+    }
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
Index: /A2P/a2p/AFPDS/ControlRecordDef.pm
===================================================================
--- /A2P/a2p/AFPDS/ControlRecordDef.pm	(revision 3)
+++ /A2P/a2p/AFPDS/ControlRecordDef.pm	(revision 3)
@@ -0,0 +1,228 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Module to initialize Control Record definitions
+
+package AFPDS::ControlRecordDef;
+
+use strict;
+use A2P::Globals ;
+use A2P::Syslog ;
+
+BEGIN {
+    use Exporter ();
+    our ( $VERSION , @ISA , @EXPORT );
+
+    $VERSION = sprintf "%s", q$Rev: 717 $ =~ /(\d[0-9.]+)\s+/ ;
+
+    @ISA    = qw(Exporter);
+    @EXPORT = qw( %RCDEF %SIZE );
+}
+our $VERSION ;
+
+# Exported Variables
+our %RCDEF = () ;
+our %SIZE  = () ;
+
+#=======================================================================
+# initialisation code - stuff the DATA into the RCDEF hash
+#=======================================================================
+my $T = "" ;
+my $index = 0 ;
+my %data  = ();
+
+&Debug("Loading RCDEF...");
+while (<DATA>)
+{
+    chomp ;
+    next if /^\s*$/ ; # Skip empty lines
+    next if /^#/    ; # Skip comment line
+
+    my ( $rec , $tag , $comment ) =
+        /^\s*(\w+)\s+=>\s+(.*)\s*#\s+(\w+.*)\s*$/i ;
+
+    die "Bad line $_ found in Record Control definitions"
+        unless (defined($rec));
+
+    if ( $rec =~ /^type$/i ) {
+        ( $tag ) = $tag =~ /^(\w+)/ ;
+        &Debug("Loading new Record Control definition type '$tag'");
+        $T = "$tag" ;
+        $index = 1 ;
+        next ;
+
+    } elsif ( $rec =~ /^__SPLIT__$/i
+    and $tag =~ /^<code\s*name=["'](\w+)["']\s*>\s*$/i ) {
+        my $name = $1 ;
+
+        &Debug("Loading afpds splitter '$name' with RC type $tag");
+        my $splitter = "" ;
+        while (my $line = <DATA>) {
+            last if ( $line =~ /^\s*<\/code>\s*$/ );
+            $splitter .= $line ;
+        }
+        &Debug("Loaded splitter is ".length($splitter)." long");
+        my $code = eval( "sub { $splitter }" );
+
+        die "Can't load '$name' splitter with invalid code\n"
+            unless (defined($code) and ref($code) =~ /^CODE$/);
+
+        $RCDEF{$T}->{'__A2P_SPLITTER__'} = $code ;
+        &Debug("Splitter $name loaded");
+        next ;
+    }
+
+    die "No Record Control type defined for line $_"
+        unless ( $T );
+
+    # Extract now the pos and the id
+    my ( $pos, $id ) =
+        $tag =~ /^Pos:\s+([-+0-9*]+)\s+:\s+(\w+)\s*$/i ;
+
+    die "Bad format in $_ line found in Record Control type $T definition with".
+        "'$tag' field definition"
+        unless ( $rec and $pos and $id and $comment );
+
+    #&Debug("Type=$T ; Index=$index ; Rec=$rec ; Pos=$pos ; Id=$id ; Comment=<$comment>");
+
+    $data{$T}->[$index++] = [ $rec => $pos ];
+}
+
+close(DATA);
+
+&Debug("Analysing RCDEF...");
+
+foreach $T (keys(%data)) {
+    my ( $key , $pos , $curpos , $size ) = ( "" , 0 , 0 , 0 );
+    $index = 1 ;
+    while (defined($data{$T}->[$index])) {
+        ( $key , $pos ) = @{$data{$T}->[$index++]} ;
+        if ( $pos =~ /-/ ) {
+            # First position must be in x-y style
+            ( $curpos , $size ) = split( "-" , $pos );
+
+            die "Bad POS format in Control Record def ($index)"
+                unless (defined($curpos) and defined($size));
+
+            $size -= $curpos - 1 if ( $size ne '*' );
+
+            die "Bad SIZE $size found in Control Record def ($index)"
+                unless ( $size > 0 or $size eq '*');
+
+        } elsif ( $pos =~ /\+(\d+)/ ) {
+            $size = $1 ;
+
+            die "Bad $pos size definition found in Control Record def ($index)"
+                unless $size ;
+
+        } else {
+            die "$pos is not a POS definition in Control Record def ($index)";
+        }
+
+        #&Debug("T$T: RC{$key} def = pos $curpos ( $size long )");
+        if ( $size eq '*' ) {
+            $RCDEF{$T}->{$key} = [ $curpos , -1 ];
+            $SIZE{$T} = -1 ;
+
+        } else {
+            $RCDEF{$T}->{$key} = [ $curpos , $size ];
+            $curpos += $size ;
+            $SIZE{$T} = $curpos - 1
+                if ( !defined($SIZE{$T}) or $SIZE{$T} < $curpos - 1 );
+        }
+    }
+    #&Debug("RC type $T is $SIZE{$T} bytes long");
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
+
+__DATA__
+
+################################################################################
+TYPE => 001                             # RC001
+    UTIPRJ    =>  Pos: 6-7   : UTIPRJ   # Code projet 'RS'
+    UTISTE3   =>  Pos: +3    : UTISTE3  # Code société 'P10'
+    UTICPR    =>  Pos: +3    : UTICPR   # Centre de profit '036'
+    IMPDOCA   =>  Pos: +2    : IMPDOCA  # Code application '20'
+    IMPDOCN   =>  Pos: +2    : IMPDOCN  # Numéro de document '01'
+    TRTDAT    =>  Pos: +8    : TRTDAT   # Date de formatage 'yyyymmdd'
+    IMPHEU    =>  Pos: +7    : IMPHEU   # Heure de formatage 'hhmmssc'
+    COPIES    =>  Pos: +3    : IMPCOPN  # Number of copies to add
+    FORM      =>  Pos: +4    : IMPFORN  # Sheet number (Numéro de formulaire)
+    DESTID    =>  Pos: +8    : IMPLU    # printer (Terminal ID)
+    IMPCLAS   =>  Pos: +1    : IMPCLAS  # printing class
+    BURST     =>  Pos: +1    : IMPBURS  # burst
+    FLASH     =>  Pos: +4    : IMPFLAS  # flash
+    CHARS     =>  Pos: +16   : IMPCHAR  # chars (4x4 pos.)
+    PAGEDEF   =>  Pos: +6    : IMPPAGD  # PageDef
+    FORMDEF   =>  Pos: +6    : IMPPAGD  # Formdef
+    HOLD      =>  Pos: +1    : IMPHOLD  # hold
+    PRIORITY  =>  Pos: +2    : IMPPRIO  # priority
+    __SPLIT__ =>  <code name='DESTID_Splitter'> # Perl code to split AFPDS
+        # We just want to split AFPDS when DESTID has changed, so just return it
+        my $RC = shift ;
+        return $RC->{DESTID} ;
+    </code>
+
+################################################################################
+TYPE => 100                             # RC100
+    UTIPRJ    =>  Pos: 6-7   : UTIPRJ   # Code projet 'RS'
+    UTISTE3   =>  Pos: +3    : UTISTE3  # Code société 'P10'
+    UTICPR    =>  Pos: +3    : UTICPR   # Centre de profit '036'
+    IMPDOCA   =>  Pos: +2    : IMPDOCA  # Code application '20'
+    IMPDOCN   =>  Pos: +2    : IMPDOCN  # Numéro de document '01'
+    TRTDAT    =>  Pos: +8    : TRTDAT   # Date de formatage 'yyyymmdd'
+    IMPHEU    =>  Pos: +7    : IMPHEU   # Heure de formatage 'hhmmssc'
+    CHARS     =>  Pos: +16   : IMPCHAR  # chars (4x4 pos.)
+    PAGEDEF   =>  Pos: +6    : IMPPAGD  # PageDef
+    FORMDEF   =>  Pos: +6    : IMPPAGD  # Formdef
+    RECORD    =>  Pos: 6-60  : RECORD   # To put in Arch file
+
+################################################################################
+TYPE => 101                             # RC101
+    RECORD    =>  Pos: 6-114 : RECORD   # brut transcrit
+
+################################################################################
+TYPE => 102                             # RC102
+    RECORD    =>  Pos: 6-135 : RECORD   # brut transcrit
+
+################################################################################
+TYPE => 103                             # RC103
+    RECORD    =>  Pos: 6-35  : RECORD   # brut transcrit
+
+################################################################################
+################### Control Record in 200-299 are not sized  ###################
+################### But need a RECORD definition             ###################
+################################################################################
+TYPE => 200                             # RC200
+    RECORD    =>  Pos: 6-*   : XML      # as <a2p><service name='xxx'/></a2p>
+
+################################################################################
+TYPE => 201                             # RC201
+    RECORD    =>  Pos: 6-*   : START    # empty start record
+
+################################################################################
+TYPE => 202                             # RC202
+    RECORD    =>  Pos: 6-*   : STOP     # empty stop record
+
+################################################################################
Index: /A2P/a2p/AFPDS/Flux.pm
===================================================================
--- /A2P/a2p/AFPDS/Flux.pm	(revision 3)
+++ /A2P/a2p/AFPDS/Flux.pm	(revision 3)
@@ -0,0 +1,938 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Class to implement print object
+#
+
+package AFPDS::Flux;
+
+use strict ;
+use Encode 'from_to' ;
+use A2P::Globals ;
+use A2P::Syslog;
+use AFPDS::MODCA ;
+use A2P::Common qw( validate );
+use A2P::Com    qw( GetCom comINF );
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 1023 $ =~ /([0-9.]+)\s+/ ;
+}
+our $VERSION ;
+
+sub new {
+    &Debug("new AFPDS::Flux v$VERSION");
+    my $class = shift ;
+    my $self = {
+        AFPDSFILE       =>  shift   ,   PAGEFORMATs =>  {}        ,
+        LogoLines       =>    []    ,   COPYGROUPs  =>  {}        ,
+        PAGES           =>    0     ,   FORMDEF     =>  ""        ,
+        LANDSCAPE       =>    0     ,   PAGEDEF     =>  ""        ,
+        LastChannel     =>    1     ,   OUTFILE     =>  "none"    ,
+        CHANNELNUMBER   =>    1     ,   CHANNEL     =>  'A'       ,
+        MaxRepeat       =>    1     ,   LOGOS       =>  []        ,
+        LINE            =>    0     ,   LINES       =>  []        ,
+        PrintLineTab    =>    []    ,   PrintLine   =>  {}        ,
+        PCLCOND         =>    0     ,   INSERT_LOGO =>  0         ,
+        StartNewPage    =>    0     ,   ROTSEGMENT  =>  0         ,
+        CurrentPAGEFORMAT =>  ""    ,   THREAD      =>  shift     ,
+        BADCHANNELALERT =>    0     ,   JOB         =>  shift     ,
+        ERROR           =>    []    ,   LOGOs       =>  {}        ,
+        OPENEDCHANNEL   =>    0     ,   COPYGROUP   =>  ""        ,
+        OPENEDPFORMAT   =>    0     ,   LOGO_INDEX  =>  0         ,
+        HAS_LOGO        =>    0     ,   PAGEFORMAT  =>  ""        ,
+        RESOURCE        =>    {}    , SELECTED_RESOURCE => ""     ,
+        DefaultTRC      =>    "\\FONtTrcA",
+        LastDefaultTRC  =>    "\\FONtTrcA",
+        texpackages     =>    [ 'afp2print' ]
+    };
+
+    return bless $self , $class ;
+}
+
+sub Return {
+    # Used to call Return member to be able to provide info to JobManager
+    my $self = shift ;
+    my $this = $self->{THREAD} ;
+    $this->Return( $self->{JOB} => &GetCom( comINF, Conversion => @_ ));
+}
+
+sub getlineindex {
+    my $self = shift ;
+    return $self->{LINE} ;
+}
+
+sub afpline {
+    my $self    = shift ;
+    my $cctrl   = shift ;
+    my $buffer  = shift ;
+
+    my ( $comment , $lsp ) = ( "none" , 0 );
+
+    # If no PageFormat still has been requested, we must load the first one
+    # as default before output any line
+    unless ($self->{PAGEFORMAT}) {
+        $self->{COPYGROUP}   = "%\n% No COPYGROUP defined"
+            unless ($self->{COPYGROUP});
+        $self->{PAGEFORMAT}  = "\\pageformatA{%" ;
+        # This is simulating printing on channel 1, so $cctrl = 1 is implicite
+        $cctrl = '1' ;
+    }
+
+    if ( $cctrl eq " " ) {
+        $comment = "Space one line then print (single spacing)";
+        $lsp = 1 ;
+
+    } elsif ( $cctrl eq "0" ) {
+        $comment = "Space 2 lines then print (double spacing)";
+        $lsp = 2 ;
+
+    } elsif ( $cctrl eq "-" ) {
+        $comment = "Space 3 lines then print (triple spacing)";
+        $lsp = 3 ;
+
+    } elsif ( $cctrl eq "+" ) {
+        $comment = "Suppress spacing, then print (overstrike previous line)";
+        $lsp = 0 ;
+        if ($self->LastLineMatch(qr/^\\PrintLineChannel/,2)
+        and $self->{LINE} == $self->{MaxRepeat} and $self->{MaxRepeat} > 0) {
+            $comment .= ", selecting new channel" ;
+            my @insertlines = pop( @{$self->{LINES}} );
+            unshift @insertlines , pop( @{$self->{LINES}} );
+            $self->nextChannel();
+            $self->addline( @insertlines );
+        }
+
+    } elsif ( $cctrl =~ /^[1-9ABC]$/i ) {
+        if ($self->nextChannel($cctrl)) {
+            $comment = "Print data to Channel #" . $self->{CHANNELNUMBER} ;
+
+        } else {
+            # Work around for bad channel selection
+            $comment = "Space one line then print (single spacing)";
+            $lsp = 1 ;
+        }
+
+    } else {# Not an ANSI Carriage Control Character,
+            # see table 1. p7 of Advanced Function Presentation:
+            #     Programming Guide and Line Data Reference
+        &Error(sprintf("Got '$cctrl' (%Xh) not supported control char",$cctrl));
+        return undef;
+    }
+    &Debug("cctrl=[$cctrl], $comment");
+
+    # Compute Line Max repetition and switch to next channel if needed
+    $self->{LINE} += $lsp ;
+
+    # Start new channel when required
+    $self->nextChannel()
+        if (( $self->{LINE} > $self->{MaxRepeat} and $self->{MaxRepeat} > 0 )
+        or $self->{StartNewPage} );
+
+    # Insert Line spacing if necessary
+    if ($lsp > 0) {
+
+        # Update previous line spacing if exists
+        if ( $self->LastLineMatch( qr/\\LineSpacing\{\d+\}%$/ ) ) {
+            # We prefer update last Linespacing
+            my $index   = $#{$self->{LINES}} ;
+            ${$self->{LINES}}[$index] =~ /\{(\d+)\}%$/ ;
+            $lsp += $1 ;
+            ${$self->{LINES}}[$index] =~ s/\{\d+\}%$/\{$lsp\}%/ ;
+
+        } else {
+            $self->newline( "\\LineSpacing{$lsp}%" );
+        }
+    }
+
+    # Is fieldAA is defined ? If no, just print the line as is
+    if (defined($self->{PrintLine}->{'fieldAAstart'})) {
+        my $buflen = length( $buffer );
+        my @fields = grep( /^field..start$/ , keys(%{$self->{PrintLine}}) ) ;
+        map s/start$//, @fields ; # Just keep indexes which are in upper case
+        for my $field ( @fields ) {
+
+            my ( $start , $len ) = ( $field . "start" , $field . "length" );
+
+            # Check field definition from auto-generated library, needed to
+            # detect bad converted Perl library
+            if (!( defined($self->{PrintLine}->{$start})
+            and defined($self->{PrintLine}->{$len}))) {
+                &Error("Found incomplete field for field $field");
+                next ;
+            }
+
+            my $readlen   = $self->{PrintLine}->{$len} ;
+            my $readstart = $self->{PrintLine}->{$start} - 1 ;
+
+            # Check there is enough text in buffer to extract field value
+            if ( $readstart >= $buflen ) {
+                #&Debug("text for field $field starts out of buffer, skip it" );
+                next ;
+            }
+
+            # Check available text length from buffer for that field
+            if ( $readstart + $readlen > $buflen ) {
+                &Debug("Available text for field " . $field .
+                    " is not as long as expected ($readlen chars)");
+                $readlen = $buflen - ( $self->{PrintLine}->{$start} - 1 ) ;
+                &Debug("Will read only $readlen chars from buffer");
+            }
+
+            # Extract text from buffer and validate it
+            my $text = substr( $buffer , $readstart , $readlen ) ;
+            &validate( \$text ) ;
+
+            # Don't print this text if there's only white spaces
+            if ( $text =~ /\S/ ) {
+                &Debug("Print new $field: length=$readlen, text='$text')");
+                $self->newline( "\\" . $field . "{$text}%" ) ;
+            }
+        }
+    } else {
+
+        &validate( \$buffer );
+        # Print a non formatted line if not empty
+        $self->newline("\\PrintLine{" . $buffer . "}%") if (length($buffer));
+    }
+
+    # Remember which channel is defined next time
+    $self->{LastChannel} = $self->{CHANNELNUMBER};
+}
+
+sub nextChannel {
+    my $self    = shift ;
+    my $channel = shift ;
+    my $startnewpage = 0 ;
+
+    if (defined($channel)) {
+        $self->{CHANNELNUMBER} = eval("0x$channel"); # Hex evaluation is correct
+
+        # Start a new page on that channel if asking the same channel as
+        # previous (default to 1), so this activate also the first page
+        # (LastChannel default to 1) or if new channel is lower than previous
+        $startnewpage ++
+            if ( $self->{LastChannel} >= $self->{CHANNELNUMBER}
+            or $self->{StartNewPage} );
+
+    } else {
+        &Debug("No channel selection defined");
+        # Use next channel on the pagedef (or next FCB in old logic)
+        $self->{CHANNELNUMBER} ++ ;
+
+        # Start a new page on channel 1 if no more channel in PAGEDEF available
+        if ( $self->{StartNewPage}
+        or ! defined(${$self->{PrintLineTab}}[$self->{CHANNELNUMBER}]) ) {
+            $startnewpage ++ ;
+            $self->{CHANNELNUMBER} = 1 ;
+        }
+    }
+
+    $channel = $self->{CHANNELNUMBER} ;
+    &Debug("Selecting channel #" . $channel );
+
+    # Check channel has been defined in library unless it's the first channel
+    # (default)
+    if ( $channel > 1 ) {
+        unless (defined(${$self->{PrintLineTab}}[$channel])
+            and ${$self->{PrintLineTab}}[$channel])
+        {
+            # If channel is defined, {PrintLine} must a hash, otherwise don't
+            # select TeX not defined channel
+            $self->addline("% Bad channel #$channel selection here");
+            $self->Return("Bad channel #$channel selection found");
+            &Warn("Bad channel #$channel on P1" . $self->{PAGEDEF});
+            # Only warn with max informations one time
+            &Warn("Tried to select bad printline channel with pageformat " .
+                $self->{CurrentPAGEFORMAT} . "during processing on " .
+                $self->{OUTFILE})
+                    unless ($self->{BADCHANNELALERT} ++);
+            return 0 ;
+        }
+    }
+
+    # Start new page if required
+    $self->startnewpage() if $startnewpage ;
+
+    # Del the previous line if not needed and fix channel block
+    if ($self->LastLineMatch( qr/^\\PrintLineChannel/ )) {
+        $self->deloneline();
+
+    } elsif ($self->{OPENEDCHANNEL}) {
+        # Close previous channel
+        $self->closeblock();
+
+        # Select default font if it has changed
+        $self->{TRCFONT} = $self->{DefaultTRC}
+            unless (defined($self->{TRCFONT}) or
+                $self->{LastDefaultTRC} eq $self->{DefaultTRC});
+    }
+
+    # Skip font selection when it has not changed
+    undef ($self->{TRCFONT})
+        if (defined($self->{TRCFONT})
+        and $self->{TRCFONT} eq $self->{LastDefaultTRC});
+
+    # Open this channel TeX block
+    $self->openblock() unless ($self->LastLineMatch( qr/{%$/ ));
+    $self->{LastDefaultTRC} = $self->{DefaultTRC} ;
+
+    # Authorize TeX to load corresponding channel definitions
+    $self->newline( "\\PrintLineChannel" . chr( 64 + $channel ) . "%" );
+
+    # Initialize new known channel
+    $self->{PrintLine} = ${$self->{PrintLineTab}}[$channel];
+
+    # Reset line repetition control
+    $self->{MaxRepeat} = $self->{PrintLine}->{'REPEAT'} ;
+    $self->{LINE} = 1 ;
+}
+
+sub addline {
+    my $self = shift ;
+    push @{$self->{LINES}} , @_ if @_;
+}
+
+sub openblock {
+    # It's better to select font before opening the block
+    defined($_[0]->{TRCFONT}) ? $_[0]->newline( "{%" ) : $_[0]->addline( "{%" );
+    $_[0]->{OPENEDCHANNEL} = 1 ;
+}
+
+sub closeblock {
+    $_[0]->addline( "}%" );
+    $_[0]->{OPENEDCHANNEL} = 0 ;
+}
+
+sub newline {
+    my $self = shift ;
+    my $line = shift ;
+
+    # Insert TRC font selection if defined
+    if (defined($self->{TRCFONT})) {
+        # Del the previous line if also and only a font selection
+        $self->deloneline() if ($self->LastLineMatch( qr/^\\FONtTrc\w+%$/ ));
+
+        # Insert TRC font selection
+        if ( $line !~ /^\\/ ) {
+            $self->addline( $self->{TRCFONT} . "%" );
+
+        } else {
+            $line = $self->{TRCFONT} . $line ;
+        }
+
+        # undefine it to not select font next call
+        undef $self->{TRCFONT} ;
+    }
+
+    $self->addline( $line );
+}
+
+sub newlogo {
+    my $self = shift ;
+    my $logo = shift ;
+
+    # Current document has logos
+    $self->{HAS_LOGO} ++ ;
+
+    push @{$self->{LogoLines}} , $logo ;
+}
+
+sub tex_logo_tag { "%%INSERT LOGO HERE" }
+
+sub addsegpath {
+    my $self = shift ;
+    my ( $path, $name ) = @_ ;
+
+    # Add path only if logo is still not in our list
+    push @{$self->{LOGOS}}, $path . $name . '.def'
+        unless (exists($self->{LOGOs}->{$name}));
+}
+
+sub insertLogos {
+    my $self = shift ;
+    my $logo = $self->{LOGO_INDEX} ;
+
+    &Debug("Inserting " . @{$self->{LogoLines}} . " lines for logos");
+
+    if ( ! @{$self->{LogoLines}} or $self->{INSERT_LOGO} > 0 ) {
+        # Insert current logos
+        if ( $self->{INSERT_LOGO} and $logo ) {
+            local $" = "\n" ;
+
+            if ( $self->{LINES}->[$logo] eq tex_logo_tag ) {
+                &Debug("Inserting logos at previous position tag");
+                $self->{LINES}->[$logo] = @{$self->{LogoLines}} ?
+                    "@{$self->{LogoLines}}" : "% No logo inserted" ;
+
+                # Fix logo insertion index
+                $self->addline( tex_logo_tag );
+
+                # Keep logo index
+                $self->{LOGO_INDEX} = $#{$self->{LINES}} ;
+
+            } else {
+                # TODO Check if this case happens some time
+                &Warn("Not expected logo insertion detected (case #1)");
+
+                # Append logo lines to last inserted logo
+                $self->{LINES}->[$logo] .= "\n@{$self->{LogoLines}}" ;
+            }
+
+        } elsif ($self->{HAS_LOGO} or ($self->{LINE} and $self->{PAGES})) {
+
+            &Debug("Inserting logos position tag");
+            # Fix logo insertion index
+            $self->addline( tex_logo_tag );
+
+            $self->{INSERT_LOGO} ++ ;
+
+            # Keep logo index
+            $self->{LOGO_INDEX} = $#{$self->{LINES}} ;
+
+        } else {
+            &Debug("Nothing to insert");
+        }
+
+    } else {
+        if (@_ and $_[0] =~ /^LASTINSERT$/) {
+            # Called from the end: it's a very bad case
+            # TODO Check if this case happens some time
+            &Warn("Not expected logo insertion detected (case #2)");
+
+            # Append logo lines to last inserted logo
+            local $" = "\n" ;
+            $self->{LINES}->[$logo] .= "\n@{$self->{LogoLines}}" ;
+
+        } else {
+            &Debug("Inserting logos at current position");
+            # Normal case, just add logo lines to lines buffer
+            $self->addline( @{$self->{LogoLines}} );
+
+            # Keep logo index
+            $self->{LOGO_INDEX} = $#{$self->{LINES}} ;
+        }
+    }
+
+    $self->{LogoLines} = [] ;
+    # Reset flag rotsegment to default
+    $self->{ROTSEGMENT} = 0 ;
+}
+
+sub selectDefaultTRC {
+    # Set current default TRC
+    $_[0]->addline( $_[0]->{DefaultTRC} ."%" );
+}
+
+sub selectTRCfont {
+    # This function analyses the second binary value from linedata
+    # It is given as ascii code of a char
+    my $self = shift ;
+    my $TRC  = shift ;
+    my $font = "" ;
+
+    &Debug("TRC font selection byte is $TRC " . sprintf("(0x%X)",$TRC));
+    # Ignore left most bits if higher or equal to 0xF0
+    $TRC &= 0x0F if ($TRC >= 0xF0);
+
+    &Debug("Font still selected") , return if ( $self->{CurrentTRC} == $TRC );
+    $self->{CurrentTRC} = $TRC ;
+
+    # We should not need more TRC fonts, and this skip considering 0x40
+    # often found and invalid value
+    if ( $TRC < 20 ) { # Must be adapted as needed
+    #if ( $TRC < 128 ) {
+        #if ( $TRC > 25 ) {
+        #    $font = chr( 65 + $TRC / 26 );
+        #    $TRC %= 26 ;
+        #}
+        $font .= chr( 65 + $TRC );
+        $self->{TRCFONT} = "\\FONtTrc$font" ;
+        &Debug("Selecting Trc{$font} font");
+    } else {
+        &Debug("Forcing default TrcA font selection as TRC byte is '$TRC'");
+        $self->{TRCFONT} = "\\FONtTrcA" ;
+    }
+
+    # Redefine default TRC when selecting TRC at the base document
+    $self->{DefaultTRC} = $self->{TRCFONT} ;
+}
+
+sub startnewpage {
+    my $self = shift ;
+    $self->{LINE} = 1 ;
+
+    # Remove any unuseful line spacing
+    while ( $self->LastLineMatch( qr/LineSpacing/ ) ) {
+        $self->deloneline();
+    }
+
+    # Close current Page and open new one
+    if ($self->{OPENEDCHANNEL}) {
+        # Close previous channel if one opened
+        $self->closeblock();
+    }
+
+    # Check if we are closing the first page reaching the linemax limit
+    # (COPYGROUP still not set to close a TeX block)
+    if ( $self->{COPYGROUP} !~ /^}%/ and $self->{PAGES} > 0 ) {
+        $self->addline( "}%\n" );
+
+    } else {
+        $self->addline( $self->{COPYGROUP} );
+    }
+    $self->addline( $self->{PAGEFORMAT} );
+    $self->insertLogos();
+    $self->{PAGES} ++ ;
+
+    # Select last used font for this pageformat
+    $self->selectDefaultTRC();
+
+    &UPSTAT('GETJOBPAGE');
+
+    &Debug("Composing page number $self->{PAGES}");
+    $self->{LastChannel}  = 1 ;
+    $self->{StartNewPage} = 0 ;
+
+    # To close last pageformat as at least one is inserted
+    $self->{OPENEDPFORMAT}= 1 ;
+}
+
+sub updateFlux {
+    my $self = shift ;
+    my $hashref = shift ;
+    map {
+        if ( ref($hashref->{$_}) =~ /^HASH/ ) {
+            my $key = $_ ;
+            map {
+                $self->{$key}->{$_} = $hashref->{$key}->{$_}
+            } keys(%{$hashref->{$key}}) ;
+
+        } else {
+            $self->{$_} = $hashref->{$_}
+        }
+    } keys(%{$hashref}) ;
+}
+
+sub updateEnv {
+    my $self = shift ;
+    my $hashref = shift ;
+    map { $self->{JOBENV}->{$_} = $hashref->{$_} } keys(%{$hashref}) ;
+}
+
+sub toclean {
+    my $self = shift ;
+    my $toclean = $self->{JOBENV}->{TOCLEAN} ;
+    $toclean .= ';' if $toclean ;
+    $toclean .= shift ;
+    $self->{JOBENV}->{TOCLEAN} = $toclean ;
+}
+
+sub has_pageformat {
+    my $self = shift ;
+    return ( defined($self->{PAGEFORMAT}) and $self->{PAGEFORMAT} ) ? 1 : 0 ;
+}
+
+sub orientations {
+    my $self = shift ;
+    return ( $self->{LANDSCAPE}, $self->{ROTSEGMENT} ) ;
+}
+
+sub issplitted {
+    my $self = shift ;
+    return exists($self->{JOBENV}->{SPLIT_TAG}) ;
+}
+
+sub getEnv {
+    my $self = shift ;
+
+    my $JobEnv = $self->{JOBENV} ;
+
+    # Only return the requested argument value if exists
+    return $JobEnv->{$_[0]} || 0 if ( @_ and defined($_[0]) );
+
+    # Update COPIES as it's not including first print
+    $JobEnv->{COPIES} = scalar($JobEnv->{COPIES}) + 1 ;
+
+    return join('',
+        map {
+            qq|<env key='$_'>| . $JobEnv->{$_} . qq|</env>|
+        } keys(%{$JobEnv}) );
+}
+
+my $yes = qr/^yes$/i ;
+sub getstat {
+    my $self = shift ;
+
+    my $kind = 'P' ; # By default, it's a print
+    my $env = $self->{JOBENV} ;
+
+    if ( defined($env->{ISPRINT}) and ! $env->{ISPRINT} ) {
+        if ( defined($env->{DO_ARCH}) and $env->{DO_ARCH} =~ $yes ) {
+            $kind = 'A' ;
+        }
+        if ( defined($env->{DO_ESERVICE}) and $env->{DO_ESERVICE} =~ $yes ) {
+            $kind = ( $kind eq 'A' )? 'E' : 'S' ;
+        }
+    }
+
+    return ( $env->{JOBNAME}, $env->{DESTID}, $env->{PAGEDEF}, $env->{FORMDEF},
+        $env->{DOCNAME}, join('+',keys(%{$self->{PAGEFORMATs}})),
+        join('+',keys(%{$self->{COPYGROUPs}})),
+        join('+',keys(%{$self->{LOGOs}})),
+        $self->{PAGES} * $env->{COPIES}, $kind, $LOCKID );
+}
+
+sub deloneline {
+    my $self = shift ;
+    return defined( pop( @{$self->{LINES}} ) ) ;
+}
+
+sub LastLineMatch {
+    my $self    = shift ;
+    my $pattern = shift ;
+    my $index   = $#{$self->{LINES}} ;
+    $index -= $_[0] if ($_[0]);
+    return 0 if ( $index < 0 ); # $#{} gives -1 when array is empty or undefined
+    return ${$self->{LINES}}[$index] =~ $pattern ;
+}
+
+sub getoutbase {
+    my $self = shift ;
+    return $self->{OUTFILE} || '' ;
+}
+
+sub setoutfile {
+    my $self    = shift ;
+    my $outfile = shift ;
+    &Debug("Updating OUTFILE='$self->{OUTFILE}' with '$outfile'");
+    $self->{OUTFILE} = $outfile ;
+}
+
+sub setTRCforTeX {
+    my $self    = shift ;
+    my $texcode = shift ;
+    return if (!defined($texcode));
+    return if (length($texcode) == 0);
+    $self->{TRCTeXCode} = "\n" . $texcode . "\n" ;
+    &Debug("TRCTeXCode initialized");
+}
+
+sub setpagedef {
+    my $self    = shift ;
+    my $pagedef = shift ;
+    &Debug("Updating PAGEDEF='$self->{PAGEDEF}' with '$pagedef'");
+    $self->{PAGEDEF} = $pagedef ;
+}
+
+sub pagedef {
+    my $self = shift ;
+    return $self->{PAGEDEF} || "" ;
+}
+
+sub setformdef {
+    my $self    = shift ;
+    my $formdef = shift ;
+    &Debug("Updating FORMDEF='$self->{FORMDEF}' with '$formdef'");
+    $self->{FORMDEF} = $formdef ;
+}
+
+sub setpclcond {
+    my $self = shift ;
+    my $cond = shift ;
+    $cond = 0 if (!defined($cond));
+    &Debug("Updating PCLCOND='$self->{PCLCOND}' with '$cond'");
+    $self->{PCLCOND} = $cond ;
+}
+
+sub gentex {
+    my $self = shift ;
+    my $file = shift ;
+    my $line ;
+    my $index = 0 ;
+    my $pclspecial = "" ;
+
+    # Add automatically EOL to each print command
+    local $\ = "\n" ;
+
+    # Set a localtime mark up
+    $self->{TeXGenTime} = localtime() ;
+
+    # Flush LogoLines if empty new page still exists
+    $self->insertLogos('LASTINSERT') if ( $#{$self->{LogoLines}} >= 0 );
+
+    # PageDef and FormDef should right at that time
+    push @{$self->{texpackages}} , "p1" . lc( $self->{PAGEDEF} ) ;
+    push @{$self->{texpackages}} , "f1" . lc( $self->{FORMDEF} ) ;
+
+    # Check if PCL5 will be generated to define some TeX special command
+    # 1. \pclportrait and \pcllandscape must be set to insert usefull PCL5
+    #    commands
+    # 2. Bin/tray support, define the right \special commands to include
+    #    print specific settings
+    if ($self->{PCLCOND} and ! $USE_PCLCMD ) {
+        my $pcl5cmdpath = "/apps/afp2print/printlib/texlib" ;
+        # PCL5 commands files path can be overided using PCL5CMDPATH ENV
+        $pcl5cmdpath = $ENV{PCL5CMDPATH} if (defined( $ENV{PCL5CMDPATH} ));
+        $pcl5cmdpath =~ s/\/+$// ;
+        $pclspecial =
+            "\\def\\SelectBinTrayA{\\special{" . $self->{OUTFILE} .
+                ".trayone}}\n" .
+            "\\def\\SelectBinTrayB{\\special{" . $self->{OUTFILE} .
+                ".traytwo}}\n\n" .
+            "\\def\\pclportrait{\\special{" .
+                $pcl5cmdpath . "/afp2print_portrait.pcl5}}\n" .
+            "\\def\\pcllandscape{\\special{" .
+                $pcl5cmdpath . "/afp2print_landscape.pcl5}}\n\n" ;
+    }
+
+    # Check LOGO files are existing
+    my $segment_libraries = "" ;
+    foreach my $logo ( @{$self->{LOGOS}} ) {
+        my $thisone = "\\input{$logo}\n" ;
+        if ( -e $logo ) {
+            $logo =~ s/\.def$// ;
+            # Define image base if one exists as .def need it
+            # TODO Add this to test "or -e $logo . '.tif'" when
+            # TIFF will be supported for PCL
+            if ( -e $logo . '.png' ) {
+                $thisone = "\\def\\segbase{$logo}\n" . $thisone ;
+                &Debug("TeX code added to enable PNG image loading");
+            }
+            $segment_libraries .= $thisone ;
+
+        } else {
+            $logo =~ $1 if ( $logo =~ m|([^/]+)$| );
+            &Warn("Won't load $logo segment as not found in library");
+        }
+    }
+
+    # TeX debugging to be used in validation only
+    my $TeXDEBUG = "" ;
+    if ( $ADDTEX_DEBUG ) {
+        $TeXDEBUG .= "\\def\\DEBUG{$ADDTEX_DEBUG}\n" .
+            "\\def\\DEBUGPAGEDEF{$TEX_PAGEDEF_DEBUG}\n" .
+            "\\def\\DEBUGOVERLAY{$TEX_OVERLAY_DEBUG}\n" .
+            "\\def\\DEBUGSEGMENT{$TEX_SEGMENT_DEBUG}\n" .
+            "\\def\\SHOWSEGMENT{$TEX_SHOW_SEGMENT}\n" ;
+    }
+
+    # TeX info
+    my $DocInfo = "" ;
+    if ( $ADDTEX_DOCINFO ) {
+        $DocInfo .= "/Title   (" . $self->{JOBENV}->{JOBNAME} . ")\n"
+            if ($self->{JOBENV}->{JOBNAME});
+        $DocInfo .= "/Author  (" . $self->{JOBENV}->{USERNAME} . ")\n"
+            if ($self->{JOBENV}->{USERNAME});
+        $DocInfo .= "/Creator (A2P v" . A2P_RPM_VERSION . ")\n"
+            if (A2P_RPM_VERSION);
+        $DocInfo = "\n\\ifpdf\n\\pdfinfo{" . $DocInfo . "}\\fi\n" if $DocInfo ;
+    }
+
+    # Insert in first position default definitions package to load for archivage
+    if (defined($self->{JOBENV}->{ISPRINT}) and ! $self->{JOBENV}->{ISPRINT}) {
+        unshift @{$self->{texpackages}}, 'afp2print_archi_pre_def' ;
+    }
+
+    if ( print( $file
+        "\\documentclass{minimal}\n",
+        $self->{PCLCOND} ? "\\def\\pcloutput{1}\n" : "" ,
+        map( "\\usepackage{" . $_ . "}\n" , @{$self->{texpackages}} ) ,
+        $segment_libraries,
+        "\\listfiles\n" ,
+        "%% \n%% AFPDS File: " . $self ->{AFPDSFILE} ,
+        "\n%% FormDef   : "    . $self ->{FORMDEF} ,
+        "\n%% PageDef   : "    . $self ->{PAGEDEF} ,
+        "\n%% TexGenTime: "    . $self ->{TeXGenTime} ,
+        "\n%% \n" ,
+        "\\ResetLength\n" ,$TeXDEBUG , $DocInfo ,
+        $self->{TRCTeXCode} , $pclspecial ,
+        "\\begin{document}\\FONtTrcA% Default font") )
+    {
+        &Debug("Output TeX header done") ;
+    } else {
+        return &Error("Can't output TeX header") ;
+    }
+
+    # Output all lines stripping and compressing some unuseful patterns
+    if ( join('',map { print $file $_ } @{$self->{LINES}}) !~ /^0+$/ ) {
+        &Debug("Output TeX Content done") ;
+    } else {
+        return &Error("Can't output TeX Content") ;
+    }
+
+    # ErAl008w fix support when only close last Pageformat is one opened
+    if ( $self->{OPENEDPFORMAT} ) {
+        print( $file "}%" ) if ($self->{OPENEDCHANNEL});
+        print( $file "}%" );
+    }
+
+    # And add TeX end block to the output
+    if ( print( $file "\\end{document}" )) {
+        &Debug("Output TeX Footer done") ;
+    } else {
+        return &Error("Can't output TeX Footer") ;
+    }
+    return 1 ;
+}
+
+sub got5Achar {
+    my $self = shift ;
+
+    # Create MODCA object
+    my $afpobject = new AFPDS::MODCA( $self, @_ );
+
+    # Check object
+    my @err = $afpobject->check ;
+
+    # Create object on no check error
+    @err = $afpobject->create unless ( @err and defined($err[0]) and $err[0] );
+
+    # Report error as ABTERM if present or return 0
+    return ( @err and defined($err[0]) and $err[0] ) ? $self->ABTERM(@err) : 0 ;
+}
+
+sub setjobindex {
+    my $self = shift ;
+    # Index is starting at 0
+    $self->{JOBINDEX} = ( shift || 1 ) - 1 ;
+}
+
+sub set_resource {
+    my $self = shift ;
+    my $object = shift ;
+
+    # Resource must be a MO:DCA object
+    return $self->{SELECTED_RESOURCE} = ""
+        unless ( ref($object) =~ /^AFPDS::MODCA/ );
+
+    # Keep a uniq TeX/LaTeX name if still not set
+    my $texname = exists($self->{RESOURCE}->{$object->name}) ?
+        $self->{RESOURCE}->{$object->name}->[1] : '' ;
+
+    # Keep a resource number as expected for PCL macro ID
+    my $number = exists($self->{RESOURCE_NUMBER}) ?
+        $self->{RESOURCE_NUMBER} + 1 : 0 ;
+
+    unless ( $texname ) {
+        my $texbase = "JOB" . ( $self->{JOBINDEX} || 0 ) . $object->name ;
+        $texbase =~ y/0-9/a-j/ ;
+        $texname = $texbase ;
+
+        my %existing = map { $self->{RESOURCE}->{$_}->[1] => 1 }
+            keys(%{$self->{RESOURCE}}) ;
+
+        my $index = 0 ;
+        while (++$index) {
+            my $tag = sprintf("%02d",$index);
+            $tag =~ y/0-9/a-j/ ;
+            $texname = $texbase . $tag ;
+            last unless (exists($existing{$texname}));
+        }
+    }
+
+    # Keep buffer reference
+    $self->{RESOURCE}->{$object->name} = [ $object, $texname, $number ] ;
+
+    # Select it as current resource
+    $self->{SELECTED_RESOURCE} = $object->name ;
+
+    # Update resource number for next resource
+    $self->{RESOURCE_NUMBER} = $number ;
+}
+
+sub get_resource {
+    my $self = shift ;
+    my $name = shift || $self->{SELECTED_RESOURCE} ;
+
+    return 0 unless ($name and exists($self->{RESOURCE}->{$name}));
+
+    # Resource must be a MO:DCA object
+    my $object = $self->{RESOURCE}->{$name}->[0] ;
+    return ref($object) =~ /^AFPDS::MODCA/ ? $object : 0 ;
+}
+
+sub resource_texname {
+    my $self = shift ;
+    my $name = shift || $self->{SELECTED_RESOURCE} ;
+
+    return 0 unless ($name and exists($self->{RESOURCE}->{$name}));
+
+    return "InlineResource" . $self->{RESOURCE}->{$name}->[1] ;
+}
+
+sub resource_number {
+    my $self = shift ;
+    my $name = shift || $self->{SELECTED_RESOURCE} ;
+    my $reso = shift || 240 ;
+
+    return undef unless ($name and exists($self->{RESOURCE}->{$name}));
+
+    my $number = $self->{RESOURCE}->{$name}->[2] ;
+    # if a scalar, ref is false
+    if (ref($number)) {
+        if (exists($number->{$reso})) {
+            $number = $number->{$reso} ;
+
+        } else {
+            # Set a new number
+            $number->{$reso} = $self->{RESOURCE_NUMBER} ;
+            $number = $self->{RESOURCE_NUMBER} ++ ;
+        }
+    } else {
+        # Just initialize the number list by resolution
+        $self->{RESOURCE}->{$name}->[2] = { $reso => $number } ;
+    }
+    return $number ;
+}
+
+sub ABTERM {
+    my $self = shift ;
+    @{$self->{ERROR}} = @_ ;
+    &Error($self->{ERROR}->[1]);
+    return - $self->{ERROR}->[0] ;
+}
+
+sub geterror {
+    return @{$_[0]->{ERROR}} ;
+}
+
+sub DESTROY {
+    my $self = shift;
+    my @err  = @{$self->{ERROR}};
+
+    # Free arrays memory
+    map { $self->{$_} = () if (ref($self->{$_}) eq 'ARRAY' ) } keys(%{$self});
+
+    if (@err) {
+        &UPSTAT('GETFLUXERROR');
+        &UPSTAT('GETFLUXERROR-' . $err[0] );
+        &Debug("Conversion object for $self->{JOB} destroyed with error #" .
+            $err[0]);
+
+    } else {
+        &UPSTAT('GETGOODAFPDS');
+        &Debug("Conversion object for $self->{JOB} destroyed");
+    }
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
Index: /A2P/a2p/AFPDS/MODCA.pm
===================================================================
--- /A2P/a2p/AFPDS/MODCA.pm	(revision 3)
+++ /A2P/a2p/AFPDS/MODCA.pm	(revision 3)
@@ -0,0 +1,318 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+################################################################################
+#
+# Class to select the right AFP objects
+#
+################################################################################
+# Management of $ident tag, cf doc folder:
+# ref #1:
+#   see "Advanced Function Presentation - Programming Guide and Line
+#   Data Reference" pdf file
+# ref #2:
+#   see "Data Stream and Object Architectures - Mixed Object Document
+#   Content Architecture Reference" pdf file
+################################################################################
+
+package AFPDS::MODCA ;
+
+use strict ;
+use Encode 'from_to' ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use A2P::Tools  qw( ms compute );
+
+# Known MO:DCA objects as library
+use AFPDS::MODCA::Common ;
+use AFPDS::MODCA::BAD ;
+use AFPDS::MODCA::BOC ;
+use AFPDS::MODCA::EOC ;
+use AFPDS::MODCA::IDM ;
+use AFPDS::MODCA::IMM ;
+use AFPDS::MODCA::IOB ;
+use AFPDS::MODCA::IPS ;
+use AFPDS::MODCA::NOP ;
+use AFPDS::MODCA::OCD ;
+use AFPDS::MODCA::PTX ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 1015 $ =~ /([0-9.]+)\s+/ ;
+}
+our $VERSION ;
+our $IDENTS ;
+
+sub new {
+    my $class = shift ;
+    &Debug("new " . __PACKAGE__ . " v$VERSION object");
+
+    my $self = {
+        FLUX     => shift || 0 , # Associated flux
+        IDENT    => shift || 0 , # MO:DCA identity
+        FLAG     => shift || 0 , # MO:DCA flags
+        RESERVED => shift || 0 , # MO:DCA reserved
+        LONG     => shift || 0 , # MO:DCA length
+        BUFFER   => shift || '', # MO:DCA content buffer
+        TEXBASE  => shift || '', # TeX/LaTeX conversion base folder
+        SUBCLASS => 'unknown',
+        BORN     => ms
+    };
+
+    # Keep MO:DCA object count statistics
+    &UPSTAT('MODCA-OBJECT-USED');
+    &UPSTAT('MODCA-IN-MEM');
+
+    return bless $self , $class ;
+}
+
+sub check {
+    my $self = shift ;
+
+    return ( 250, sprintf("MO:DCA X'%06X' identity not known", $self->{IDENT}) )
+        unless (exists($IDENTS->{$self->{IDENT}}));
+
+    # Update sub class identity
+    $self->{SUBCLASS} = ref($self) . '::' . $IDENTS->{$self->{IDENT}} ;
+
+    # Auto derivation of ourself to expected AFP object
+    bless $self, $self->{SUBCLASS} ;
+
+    # Analyse flags and reserved fields
+    return $self->check_flags    if $self->check_flags ;
+    return $self->check_reserved if $self->check_reserved ;
+
+    # Really validate from validate member ob derivated object
+    return $self->validate ;
+}
+
+sub check_flags {
+    my $self = shift ;
+    my $flags = $self->{FLAGS} || 0 ;
+
+    # By default, flags is null with nothing to do
+    return 0 unless $flags ;
+
+    # Bit 4 set padding indicator, cf ref #2, p. 69-70
+    return ( 251, "Found unsupported MO:DCA padding format requirement" )
+        if ( $flags & 0x40 );
+
+    &Warn(sprintf( "Nothing to do with %08bb flags field on %s object",
+        $flags, $self->{SUBCLASS} ));
+
+    return 0 ;
+}
+
+sub check_reserved {
+    my $self = shift ;
+    my $reserved = $self->{RESERVED} || 0 ;
+
+    # By default, reserved is null with nothing to do
+    return 0 unless $reserved ;
+
+    &Debug(sprintf( "Nothing to do with 0x%04X reserved field on %s object",
+        $reserved, $self->{SUBCLASS} ));
+
+    return 0 ;
+}
+
+my %triplets_length = (
+    0x10    =>  [ 24, 56, 64, 96 ],
+    0x4B    =>  [ 8 ]
+    );
+my %supported_oid = (
+    '06072B120004010116' => [ 'GIF', '89a' ]
+    );
+
+sub check_triplets {
+    my $self = shift ;
+    my $buffer = shift || $self->{BUFFER} ;
+
+    my ( $index, $len ) = ( 0, length($buffer) );
+    while ( $index < $len ) {
+        # Get triplet length
+        my $tlen = &compute( \$buffer, $index, 1 );
+        my $next = $index + $tlen ;
+        return ( 253, "Empty triplet found" ) unless ( ++$index < $len );
+
+        # Get triplet ID
+        my $triplet = &compute( \$buffer, $index++, 1 );
+        my $id = sprintf("%02X",$triplet);
+        return ( 253, "Unsupported X'$id' triplet found" )
+            unless ( exists($triplets_length{$triplet}) );
+
+        &Debug("Found X'$id' triplet in " . $self->{SUBCLASS});
+        return ( 253, "Bad X'$id' triplet $tlen length" )
+            unless ( grep { $_ == $tlen } @{$triplets_length{$triplet}} );
+        return ( 253, "Found truncated X'$id' triplet, missing " . ($next-$len)
+            . " bytes" )
+            unless ( $next <= $len );
+
+        # Here we are sure triplet is complete
+        if ( $triplet == 0x10 ) {
+            my $zero     = &compute( \$buffer, $index++, 1 );
+            my $class    = &compute( \$buffer, $index++, 1 );
+            my $reserved = &compute( \$buffer, $index++, 2 ); $index++ ;
+            my $struct   = &compute( \$buffer, $index++, 2 ); $index++ ;
+            my @oid = map { &compute( \$buffer, $index++, 1 ) } 1..16 ;
+            while ( ! $oid[$#oid] ) { pop @oid }; # Strip last zeros
+            my $oid = join( '', map { sprintf("%02X",$_) } @oid ) ;
+            return ( 253, "Unsupported $oid OID found in X'$id' triplet for " .
+                $self->{SUBCLASS} . " object" )
+                unless (exists($supported_oid{$oid}));
+            my ( $format, $version ) = @{$supported_oid{$oid}} ;
+            if ( $tlen > 24 ) {
+                # Just log given format resource, revision and owner as debug
+                my $thisformat = substr( $buffer, $index, 32 );
+                my ( $revision, $owner ) = ( $version, 'unknown' );
+                $thisformat = $self->convert( $thisformat );
+                $index += 32 ;
+                if ( $tlen > 56 ) {
+                    $revision = substr( $buffer, $index, 8 );
+                    $revision = $self->convert( $revision );
+                    $index += 8 ;
+                    if ( $tlen > 64 ) {
+                        $owner = substr( $buffer, $index, 32 );
+                        $owner = $self->convert( $owner );
+                        $index += 32 ;
+                    }
+                }
+                &Debug("Found $thisformat resource rev$revision from " . $owner
+                    . " with $oid OID");
+            }
+
+            # Check values
+            return ( 253, "Byte at offset 2 must be zero in X'$id' triplet" )
+                if ($zero);
+            return ( 253, "Bytes at offset 4-5 must be zero in X'$id' triplet" )
+                if ($reserved);
+            return ( 253, "Unsupported $class class in X'$id' triplet" )
+                unless ( $class == 0x01 );
+            return ( 253, "Unsupported $struct structure in X'$id' triplet" )
+                unless ( $struct == 0xDC00 or $struct == 0xA800 );
+
+            # Update ourself
+            $self->{OID}     = $oid     ;
+            $self->{CLASS}   = $class   ;
+            $self->{STRUCT}  = $struct  ;
+            $self->{FORMAT}  = $format  ;
+            $self->{VERSION} = $version ;
+
+        } elsif ( $triplet == 0x4B ) {
+            my $xbase = &compute( \$buffer, $index++, 1 );
+            my $ybase = &compute( \$buffer, $index++, 1 );
+            my $xunit = &compute( \$buffer, $index++, 2 ); $index++ ;
+            my $yunit = &compute( \$buffer, $index++, 2 ); $index++ ;
+
+            # Check values
+            return ( 253, "Only 0x00 or 0x01 are supported as X base unit in X'"
+                . $id . "' triplet, but found 0x" . sprintf("%02X",$xbase) )
+                if ( $xbase < 0 or $xbase > 1 );
+            return ( 253, "Only 0x00 or 0x01 are supported as Y base unit in X'"
+                . $id . "' triplet, but found 0x" . sprintf("%02X",$ybase) )
+                if ( $ybase < 0 or $ybase > 1 );
+            return ( 253, "X units not in range [1-32767] in X'$id' triplet" )
+                if ( $xunit < 1 or $xunit > 32767 );
+            return ( 253, "Y units not in range [1-32767] in X'$id' triplet" )
+                if ( $yunit < 1 or $yunit > 32767 );
+
+            # Calculate resolutions in 'dpi' as TeX/LaTeX unit
+            my $ptbyteninch = 722.7      ; # Number of TeX Points in 10 inch
+            my $ptbytencm   = 284.527559 ; # result of ptbyteninch/ '2.54 cm/in'
+
+            # Found the number of inch as specified in base
+            # 10 cm = 10 / 2.54 = 3.937008 inches
+            $xbase = $xbase ? 3.937008 : 10 ;
+            $ybase = $ybase ? 3.937008 : 10 ;
+
+            # Get resolutions
+            $xunit /= $xbase ;
+            $yunit /= $ybase ;
+
+            return ( 253,
+                "Doesn't support X,Y different resolutions in X'$id' triplet" )
+                unless ( $xunit == $yunit );
+
+            # Keep results
+            $self->{RESOLUTION} = int($xunit) ;
+
+        } else {
+            return ( 253, "Can't analyse X'$id' triplet" );
+        }
+
+        # Control analysis is correct
+        return ( 253, "Bad analysis of X'$id' triplet ($index vs $next)" )
+            unless ( $index == $next );
+    }
+
+    return () ;
+}
+
+# Private member to override to specify supported triplets
+sub _supported_triplets {
+    # Return 2 array refs of supported triplets, first is mandatory, then not
+    return [], [] ;
+}
+
+sub get_from_buffer {
+    my $self = shift ;
+    return &compute( \$self->{BUFFER}, @_ );
+}
+
+sub convert {
+    my $self = shift ;
+    my $buffer = shift || $self->{BUFFER} ;
+    &from_to( $buffer , $FROM_CONVERT , $TO_CONVERT ) if ($DO_CONVERT);
+    $buffer =~ s/\s+$// ;
+    return $buffer ;
+}
+
+sub folder {
+    my $self = shift ;
+    return $self->{TEXBASE} || '' ;
+}
+
+sub name {
+    # Can be set by X'02' triplet
+    my $self = shift ;
+    $self->{NAME} = shift if @_ ;
+    $self->{NAME} = "NONAME" unless (exists($self->{NAME}));
+    return $self->{NAME} ;
+}
+
+sub validate {
+    my $self = ref($_[0]) ;
+    return ( 251, "MO:DCA $self object can't be validated" );
+}
+
+sub create {
+    my $self = ref($_[0]) ;
+    return ( 252, "MO:DCA $self object can't be created" );
+}
+
+sub DESTROY {
+    &DOWNSTAT('MODCA-IN-MEM');
+    &MAXMINSTAT('MODCA-AGE',&ms() - $_[0]->{BORN});
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+&Debug(__PACKAGE__."->IDENTS: ".join(", ",keys(%{$IDENTS})));
+
+1;
Index: /A2P/a2p/AFPDS/MODCA/BAD.pm
===================================================================
--- /A2P/a2p/AFPDS/MODCA/BAD.pm	(revision 3)
+++ /A2P/a2p/AFPDS/MODCA/BAD.pm	(revision 3)
@@ -0,0 +1,71 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# BAD known object
+#
+
+package AFPDS::MODCA::BAD ;
+
+use strict ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use AFPDS::MODCA::Common ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 1007 $ =~ /([0-9.]+)\s+/ ;
+}
+our $VERSION ;
+our @ISA = ("AFPDS::MODCA");
+our $IDENTS ;
+
+sub _ID { 0x404040 }
+
+sub new {
+    my $class = shift ;
+    &Debug("new " . __PACKAGE__ . " v$VERSION object");
+
+    my $self = {
+        FLUX     => 0,        # Associated flux
+        IDENT    => _ID,      # MO:DCA identity
+        FLAG     => 0,        # MO:DCA flags
+        RESERVED => 0,        # MO:DCA reserved
+        LONG     => 0,        # MO:DCA buffer length
+        BUFFER   => ''        # MO:DCA content buffer
+    };
+
+    return bless $self , $class ;
+}
+
+sub validate {
+    my $self = shift ;
+
+    &Info("Skip known bad ident 0x404040 with length=" . $self->{LONG});
+
+    return () ;
+}
+
+sub create {
+    return () ;
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+( $IDENTS->{&_ID} ) = __PACKAGE__ =~ /(\w+)$/ ;
Index: /A2P/a2p/AFPDS/MODCA/BOC.pm
===================================================================
--- /A2P/a2p/AFPDS/MODCA/BOC.pm	(revision 3)
+++ /A2P/a2p/AFPDS/MODCA/BOC.pm	(revision 3)
@@ -0,0 +1,155 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Class to export Begin Object Container members
+#
+# cf ref #2, p. 129
+#
+
+package AFPDS::MODCA::BOC ;
+
+use strict ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use AFPDS::MODCA::Common ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 1030 $ =~ /([0-9.]+)\s+/ ;
+}
+our $VERSION ;
+our @ISA = ("AFPDS::MODCA");
+our $IDENTS ;
+
+sub _ID { 0xD3A892 }
+
+sub _supported_triplets {
+    return [
+            0x10, # Mandatory object classification
+        ], [
+            # TODO support needed for next
+            # 0x01, # Coded charset GID
+            # 0x02, # FQN
+            # 0x57, # object byte extent
+            # 0x62, # local timestamp
+            # 0x65, # comment
+            # 0x72, # universal timestamp
+        ];
+}
+
+sub new {
+    my $class = shift ;
+    &Debug("new " . __PACKAGE__ . " v$VERSION object");
+
+    my $self = {
+        FLUX     => 0,        # Associated flux
+        IDENT    => _ID,      # MO:DCA identity
+        FLAG     => 0,        # MO:DCA flags
+        RESERVED => 0,        # MO:DCA reserved
+        LONG     => 0,        # MO:DCA buffer length
+        BUFFER   => ''        # MO:DCA content buffer
+    };
+
+    return bless $self , $class ;
+}
+
+sub validate {
+    my $self = shift ;
+
+    &Debug("Found BOC as new integrated resource");
+    &UPSTAT('GET-RESOURCE');
+
+    # Check minimal buffer size
+    return ( 251, "BOC is malformed as too short (" . $self->{LONG} . "<9)" )
+        if ( $self->{LONG} < 9 );
+
+    # Check FLUX is a Flux object
+    return ( 251, "BOC needs to be used with Flux object" )
+        unless ( ref($self->{FLUX}) =~ /^AFPDS::Flux$/ );
+
+    return () ;
+}
+
+sub create {
+    my $self = shift ;
+    my $flux = $self->{FLUX} ;
+
+    # Set resource name
+    my $resname = substr( $self->{BUFFER}, 0, 8 );
+    $resname = $self->convert( $resname );
+    return ( 252, "Invalid resource name found" ) unless $resname ;
+
+    # Set resource name as member as it can be later overrided by X'02' triplet
+    $self->name( $resname );
+
+    # Analyse now authorized triplets as it is mandatory
+    my @err = $self->check_triplets(substr( $self->{BUFFER}, 8 ));
+    return @err if @err ;
+
+    my $struct = $self->{STRUCT} || 0 ;
+    return ( 253, "Unexpected '$struct' structure found for BOC object" )
+        unless ( $struct == 0xDC00 );
+
+    my $class = $self->{CLASS} || 0 ;
+    return ( 253, "Unexpected '$class' class found for BOC object" )
+        unless ( $class == 0x01 );
+
+    # Add an empty buffer to the resource object
+    $self->{RESOURCE_BUFFER} = "" ;
+
+    # Set a new resource in flux object
+    $flux->set_resource($self) unless @err ;
+
+    return @err ;
+}
+
+sub teximage {
+    my $self = shift ;
+    my $reso = shift || 240 ;
+
+    # Affect image if the first argument is defined
+    $self->{TEXIMAGE}->{$reso} = shift if ( @_ and defined($_[0]) );
+
+    return ( exists($self->{TEXIMAGE}) and exists($self->{TEXIMAGE}->{$reso}) )?
+        $self->{TEXIMAGE}->{$reso} : '' ;
+}
+
+
+sub DESTROY {
+    my $self = shift;
+
+    # Output resource if not retrieved by inclusion and in DEBUG mode
+    if ( $ADVANCED_DEBUGGING or ! exists($self->{TEXIMAGE})
+    and ref($self->{FLUX}) =~ /^AFPDS::Flux/ ) {
+        my $flux = $self->{FLUX} ;
+        my $file = $flux->getoutbase . '_' . $self->name ;
+        $file .= '.' . lc($self->{FORMAT}) if (exists($self->{FORMAT}));
+        $flux->toclean( $file );
+        if ( open( OBJ, '>', $file ) ) {
+            binmode(OBJ);
+            print OBJ $self->{RESOURCE_BUFFER} ;
+            close(OBJ);
+        }
+    }
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+( $IDENTS->{&_ID} ) = __PACKAGE__ =~ /(\w+)$/ ;
Index: /A2P/a2p/AFPDS/MODCA/Common.pm
===================================================================
--- /A2P/a2p/AFPDS/MODCA/Common.pm	(revision 3)
+++ /A2P/a2p/AFPDS/MODCA/Common.pm	(revision 3)
@@ -0,0 +1,42 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+package AFPDS::MODCA::Common ;
+
+use strict ;
+use A2P::Globals ;
+use A2P::Syslog ;
+
+BEGIN {
+    use Exporter ();
+    our @ISA = qw(Exporter);
+    our @EXPORT = qw( $IDENTS );
+    our $VERSION = sprintf "%s", q$Rev: 1007 $ =~ /([0-9.]+)\s+/ ;
+}
+our $VERSION ;
+
+# Initialize identities hash reference
+our $IDENTS = {} ;
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1 ;
Index: /A2P/a2p/AFPDS/MODCA/EOC.pm
===================================================================
--- /A2P/a2p/AFPDS/MODCA/EOC.pm	(revision 3)
+++ /A2P/a2p/AFPDS/MODCA/EOC.pm	(revision 3)
@@ -0,0 +1,118 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Class to export End Object Container members
+#
+# cf ref #2, p. 164
+#
+
+package AFPDS::MODCA::EOC ;
+
+use strict ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use AFPDS::MODCA::Common ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 1007 $ =~ /([0-9.]+)\s+/ ;
+}
+our $VERSION ;
+our @ISA = ("AFPDS::MODCA");
+our $IDENTS ;
+
+sub _ID { 0xD3A992 }
+
+sub _supported_triplets {
+    return [], [
+            # 0x02 # Only X'02' FQN triplet should be supported
+        ];
+}
+
+sub new {
+    my $class = shift ;
+    &Debug("new " . __PACKAGE__ . " v$VERSION object");
+
+    my $self = {
+        FLUX     => 0,        # Associated flux
+        IDENT    => _ID,      # MO:DCA identity
+        FLAG     => 0,        # MO:DCA flags
+        RESERVED => 0,        # MO:DCA reserved
+        LONG     => 0,        # MO:DCA buffer length
+        BUFFER   => ''        # MO:DCA content buffer
+    };
+
+    return bless $self , $class ;
+}
+
+sub validate {
+    my $self = shift ;
+
+    &Debug("Found EOC to close integrated resource");
+    &UPSTAT('GET-COMPLETED-RESOURCE');
+
+    # Check FLUX is a Flux object
+    return ( 251, "EOC needs to be used with Flux object" )
+        unless ( ref($self->{FLUX}) =~ /^AFPDS::Flux$/ );
+
+    return () ;
+}
+
+sub create {
+    my $self = shift ;
+    my $resname = "" ;
+    my @err = () ;
+
+    if ( $self->{LONG} ) {
+        # Set resource name
+        $resname = substr( $self->{BUFFER}, 0, 8 );
+        $resname = $self->convert( $resname );
+
+        # Analyse authorized triplets if needed
+        @err = $self->check_triplets(substr( $self->{BUFFER}, 8 ))
+            if ( $self->{LONG} > 8 );
+
+        return @err if @err ;
+    }
+
+    # Check container is opened in flux
+    my $flux = $self->{FLUX} ;
+    my $container = $flux->get_resource($resname);
+    return ( 252, $resname ?
+        "Resource '$resname' not available" : "No resource available to close" )
+        unless ( $container and ref($container) =~ /^AFPDS::MODCA/ );
+
+    # Validate the expected structure, see BOC
+    my $struct = $container->{STRUCT} || 0 ;
+    return ( 253, "Unexpected '$struct' structure found for BOC object" )
+        unless ( $struct == 0xDC00 );
+
+    # At that time, just initialize a resource using counter
+    $container->{USED} = 0 ;
+
+    # Unselect resource in flux
+    $flux->set_resource(undef);
+
+    return @err ;
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+( $IDENTS->{&_ID} ) = __PACKAGE__ =~ /(\w+)$/ ;
Index: /A2P/a2p/AFPDS/MODCA/IDM.pm
===================================================================
--- /A2P/a2p/AFPDS/MODCA/IDM.pm	(revision 3)
+++ /A2P/a2p/AFPDS/MODCA/IDM.pm	(revision 3)
@@ -0,0 +1,133 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Class to export Invoke Data Map (PAGEFORMAT) members
+#
+# cf ref #1, p. 91
+#
+
+package AFPDS::MODCA::IDM ;
+
+use strict ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use AFPDS::MODCA::Common ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 1007 $ =~ /([0-9.]+)\s+/ ;
+}
+our $VERSION ;
+our @ISA = ("AFPDS::MODCA");
+our $IDENTS ;
+
+sub _ID { 0xD3ABCA }
+
+sub new {
+    my $class = shift ;
+    &Debug("new " . __PACKAGE__ . " v$VERSION object");
+
+    my $self = {
+        FLUX     => 0,        # Associated flux
+        IDENT    => _ID,      # MO:DCA identity
+        FLAG     => 0,        # MO:DCA flags
+        RESERVED => 0,        # MO:DCA reserved
+        LONG     => 0,        # MO:DCA buffer length
+        BUFFER   => ''        # MO:DCA content buffer
+    };
+
+    return bless $self , $class ;
+}
+
+sub validate {
+    my $self = shift ;
+
+    &Debug("Found IDM as PAGEFORMAT");
+    &UPSTAT('GETPAGEFORMAT');
+
+    # Check buffer size
+    if ( $self->{LONG} != 8 ) {
+        &Warn("Found IDM Field value with bad length (" . $self->{LONG} .
+            "), keeping only the first 8 chars");
+        $self->{BUFFER} = substr( $self->{BUFFER} , 0 , 8 );
+    }
+
+    # Check FLUX is a Flux object
+    return ( 251, "IDM needs to be used with Flux object" )
+        unless ( ref($self->{FLUX}) =~ /^AFPDS::Flux$/ );
+
+    # Check PAGEDEF is selected
+    return ( 251, "Can't set PAGEFORMAT withou PAGEDEF selected" )
+        unless ( $self->{FLUX}->pagedef );
+
+    return () ;
+}
+
+sub create {
+    my $self = shift ;
+    my $flux = $self->{FLUX} ;
+
+    # Convert buffer
+    my $pageformat = $self->convert ;
+
+    # Keep information on this use for statistics
+    $flux->{PAGEFORMATs}->{$pageformat} = 1 ;
+    &UPSTAT('USEPAGEFORMAT_' . $pageformat);
+
+    # Load the corresponding Perl module and return
+    my $PageFormatSub = "perllib::p1" . lc( $flux->pagedef ) . "::PAGEFORMAT" ;
+    my $libload = $PageFormatSub . '( "' . $pageformat .
+        '", @{$flux->{PrintLineTab}} )';
+
+    # Before trying to load, we must check sub is available
+    return ( 202, "No PageFormat available with PAGEDEF " . $flux->pagedef )
+        unless (ref( eval '\&' . $PageFormatSub ) =~ /^CODE/ );
+
+    my ( $IfLandScape , $PageFormat ) = eval( $libload );
+
+    return ( 203, "Can't load '$pageformat' Pageformat from 'P1" .
+        $flux->pagedef . "' Pagedef" ) unless (defined($PageFormat));
+
+    &UPSTAT('GETLANDSCAPEPAGE') if $IfLandScape ;
+
+    $flux->updateFlux( {
+        PAGEFORMAT => $PageFormat,
+        LANDSCAPE  => $IfLandScape,
+
+        # This force a new page with the next newline
+        StartNewPage => 1,
+
+        # This force PTCA to be stored in logo array until newline is called
+        LINE => 0,
+
+        # Only used in logging
+        CurrentPAGEFORMAT => $pageformat
+        } );
+
+    # Protect '%' from printf interpretation in syslog debugging
+    $PageFormat =~ s/%/%%/g ;
+    &Debug("PageFormat loaded: eval( $libload ) = $IfLandScape , $PageFormat");
+
+    return () ;
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+( $IDENTS->{&_ID} ) = __PACKAGE__ =~ /(\w+)$/ ;
Index: /A2P/a2p/AFPDS/MODCA/IMM.pm
===================================================================
--- /A2P/a2p/AFPDS/MODCA/IMM.pm	(revision 3)
+++ /A2P/a2p/AFPDS/MODCA/IMM.pm	(revision 3)
@@ -0,0 +1,118 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Class to export Invoke Medium Map (COPYGROUP) members
+#
+# cf ref #2, p. 178-179
+#
+
+package AFPDS::MODCA::IMM ;
+
+use strict ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use AFPDS::MODCA::Common ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 1007 $ =~ /([0-9.]+)\s+/ ;
+}
+our $VERSION ;
+our @ISA = ("AFPDS::MODCA");
+our $IDENTS ;
+
+sub _ID { 0xD3ABCC }
+
+sub new {
+    my $class = shift ;
+    &Debug("new " . __PACKAGE__ . " v$VERSION object");
+
+    my $self = {
+        FLUX     => 0,        # Associated flux
+        IDENT    => _ID,      # MO:DCA identity
+        FLAG     => 0,        # MO:DCA flags
+        RESERVED => 0,        # MO:DCA reserved
+        LONG     => 0,        # MO:DCA buffer length
+        BUFFER   => ''        # MO:DCA content buffer
+    };
+
+    return bless $self , $class ;
+}
+
+sub validate {
+    my $self = shift ;
+
+    &UPSTAT('GETCOPYGROUP');
+    &Debug("Found IMM as COPYGROUP");
+
+    # Check buffer size
+    if ( $self->{LONG} != 8 ) {
+        &Debug("Found IMM Field value with bad length (" . $self->{LONG} .
+            "), keeping only the first 8 chars");
+        $self->{BUFFER} = substr( $self->{BUFFER} , 0 , 8 );
+    }
+
+    # Check FLUX is a Flux object
+    return ( 251, "IMM needs to be used with Flux object" )
+        unless ( ref($self->{FLUX}) =~ /^AFPDS::Flux$/ );
+
+    return () ;
+}
+
+sub create {
+    my $self = shift ;
+    my $flux = $self->{FLUX} ;
+
+    # Convert buffer
+    my $copygroup = $self->convert ;
+
+    # Prepare TeX/LaTeX copygroup code
+    my $CopyGroup = "";
+
+    # Close the previous defined PageFormat before setting CopyGroup
+    $CopyGroup = "}%\n" if ($flux->has_pageformat);
+
+    # Update TeX/LaTeX copygroup code
+    $CopyGroup .= "%\n\\ResetOffset%\n\\CopyGroup" ;
+
+    # Parse found copygroup name to reset number as lowcase chars
+    for ( split( // , $copygroup ) ) {
+        if ( /\d/ ) {
+            $CopyGroup .= chr( 97 + $_ ) ;
+        } else {
+            $CopyGroup .= uc( $_ ) ;
+        }
+    }
+
+    $flux->updateFlux( {
+        COPYGROUP => $CopyGroup . "% Load '$copygroup' COPYGROUP",
+
+        # Keep information on this use for statistics
+        COPYGROUPs => { $copygroup => 1 }
+        } );
+
+    &UPSTAT('USECOPYGROUP_' . $copygroup);
+
+    return () ;
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+( $IDENTS->{&_ID} ) = __PACKAGE__ =~ /(\w+)$/ ;
Index: /A2P/a2p/AFPDS/MODCA/IOB.pm
===================================================================
--- /A2P/a2p/AFPDS/MODCA/IOB.pm	(revision 3)
+++ /A2P/a2p/AFPDS/MODCA/IOB.pm	(revision 3)
@@ -0,0 +1,439 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Class to export Include Object members
+#
+# cf ref #1, p. 92 & ref #2, p. 180
+#
+
+package AFPDS::MODCA::IOB ;
+
+use strict ;
+use GD ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use AFPDS::MODCA::Common ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 1172 $ =~ /([0-9.]+)\s+/ ;
+}
+our $VERSION ;
+our @ISA = ("AFPDS::MODCA");
+our $IDENTS ;
+
+sub _ID { 0xD3AFC3 }
+
+sub _supported_triplets {
+    return [], [
+            0x10, # Mandatory object classification only if object type is 0x92
+            0x4B, # Measurement units mandatory if coordinates are overrided
+            # 0x01, # Coded charset GID
+            # 0x02, # FQN
+            # 0x04, # Mapping option
+            # 0x4C, # object area size
+            # 0x4E, # color specs
+            # 0x70, # presentation space reset mixing
+            # 0x71, # presentation space mixing rules
+        ];
+}
+
+sub new {
+    my $class = shift ;
+    &Debug("new " . __PACKAGE__ . " v$VERSION object");
+
+    my $self = {
+        FLUX     => 0,        # Associated flux
+        IDENT    => _ID,      # MO:DCA identity
+        FLAG     => 0,        # MO:DCA flags
+        RESERVED => 0,        # MO:DCA reserved
+        LONG     => 0,        # MO:DCA buffer length
+        BUFFER   => ''        # MO:DCA content buffer
+    };
+
+    return bless $self , $class ;
+}
+
+sub validate {
+    my $self = shift ;
+
+    &Debug("Found IOB to include object");
+    &UPSTAT('GET-RESOURCE-INCLUSION');
+
+    # Check minimal buffer size
+    return ( 251, "IOB is malformed as too short (" . $self->{LONG} . "<28)" )
+        if ( $self->{LONG} < 28 );
+
+    # Check FLUX is a Flux object
+    return ( 251, "IOB needs to be used with Flux object" )
+        unless ( ref($self->{FLUX}) =~ /^AFPDS::Flux$/ );
+
+    return () ;
+}
+
+sub create {
+    my $self = shift ;
+
+    # Set resource name
+    my $resname = substr( $self->{BUFFER}, 0, 8 );
+    $resname = $self->convert( $resname );
+    return ( 252, "Invalid resource name found" ) unless $resname ;
+
+    # Set resource name as member as it can be later overrided by X'02' triplet
+    $self->name( $resname );
+
+    # Extract values
+    my $zero     = $self->get_from_buffer(  8, 1 );
+    my $ObjType  = $self->get_from_buffer(  9, 1 );
+    my $XoaOset  = $self->get_from_buffer( 10, 3 );
+    my $YoaOset  = $self->get_from_buffer( 13, 3 );
+    my $XoaOrent = $self->get_from_buffer( 16, 2 );
+    my $YoaOrent = $self->get_from_buffer( 18, 2 );
+    my $XocaOset = $self->get_from_buffer( 20, 3 );
+    my $YocaOset = $self->get_from_buffer( 23, 3 );
+    my $RefCSys  = $self->get_from_buffer( 26, 1 );
+
+    # Analyse offsets
+    unless ( $XoaOset == 0xFFFFFF ) {
+        # This is a signed number
+        $XoaOset -= 0x1000000 if ( $XoaOset > 0x7FFFFF );
+
+        # Check and set X off-set
+        return ( 252, "Found bad IOB XoaOset ($XoaOset)" )
+            if ( $XoaOset < -32768 or $XoaOset > 32767 );
+    }
+    unless ( $YoaOset == 0xFFFFFF ) {
+        # This is a signed number
+        $YoaOset -= 0x1000000 if ( $YoaOset > 0x7FFFFF );
+
+        # Check and set X off-set
+        return ( 252, "Found bad IOB YoaOset ($YoaOset)" )
+            if ( $YoaOset < -32768 or $YoaOset > 32767 );
+    }
+    unless ( $XocaOset == 0xFFFFFF ) {
+        # This is a signed number
+        $XocaOset -= 0x1000000 if ( $XocaOset > 0x7FFFFF );
+
+        # Check and set X off-set
+        return ( 252, "Found bad IOB XocaOset ($XocaOset)" )
+            if ( $XocaOset < -32768 or $XocaOset > 32767 );
+    }
+    unless ( $YocaOset == 0xFFFFFF ) {
+        # This is a signed number
+        $YocaOset -= 0x1000000 if ( $YocaOset > 0x7FFFFF );
+
+        # Check and set X off-set
+        return ( 252, "Found bad IOB YocaOset ($YocaOset)" )
+            if ( $YocaOset < -32768 or $YocaOset > 32767 );
+    }
+
+    # Check invalid values
+    return ( 252, "Invalid reserved value in IOB ($zero)" )
+        if ( $zero );
+    return ( 252, "Invalid object type in IOB ($ObjType)" )
+        unless ( $ObjType == 0x92 or $ObjType == 0x5F or $ObjType == 0xBB
+        or $ObjType == 0xEB or $ObjType == 0xFB );
+
+    # Check supported orientation
+    return ( 252, "Unsupported orientation found in IOB ($XoaOrent;$YoaOrent)" )
+        unless ( $XoaOrent == 0x0000 and $YoaOrent == 0x2D00 );
+
+    # Check supported system reference
+    return ( 252, "Unsupported RefCSys found in IOB ($RefCSys)" )
+        unless ( $RefCSys == 0x01 );
+
+    # Analyse now authorized triplets as it is mandatory
+    my @err = $self->check_triplets(substr( $self->{BUFFER}, 27 ));
+    return @err if @err ;
+
+    # Set a default resolution if not set
+    $self->{RESOLUTION} = 240 unless (exists($self->{RESOLUTION}));
+
+    # Get current resolution
+    my $reso = $self->{RESOLUTION} ;
+
+    # Update resname if update by triplet X'02', and set it with resolution
+    $resname = $self->name ;
+
+    # Check container is opened in flux
+    my $flux = $self->{FLUX} ;
+    my $container = $flux->get_resource($resname);
+    return ( 252, "Resource '$resname' not available" )
+        unless ( $container and ref($container) =~ /^AFPDS::MODCA/ );
+
+    # Validate the expected structure of BOC
+    my $struct = $container->{STRUCT} || 0 ;
+    return ( 253, "Unexpected '$struct' structure found for BOC object" )
+        unless ( $struct == 0xDC00 );
+
+    # Validate the expected structure of ourself
+    $struct = $self->{STRUCT} || 0 ;
+    return ( 253, "Unexpected '$struct' structure found for IOB object" )
+        unless ( $struct == 0xA800 );
+
+    if ( $ObjType == 0x92 ) {
+        return ( 252, "No OID found in object container for IOB" )
+            unless ( exists($container->{OID}) and $container->{OID} );
+
+        # Check triplet X'10' has been set as mandatory here and match container
+        return ( 252, "No OID found in object inclusion with IOB" )
+            unless ( exists($self->{OID}) and $self->{OID} );
+        return ( 253, "OID included is different from container" )
+            unless ( $container->{OID} eq $self->{OID} );
+
+        # Check specified class in triplet X'10'
+        my $class = $self->{CLASS} || 0 ;
+        return ( 253, "Unexpected '$class' class found for IOB object" )
+            unless ( $class == 0x01 );
+
+        # Check origins are not set for the object
+        return ( 253, "Origin offset not allowed for this IOB object" )
+            if ( $XocaOset or $YocaOset );
+
+        # Reset to default offsets for the object if not set
+        $XoaOset = 0 if ( $XoaOset == 0xFFFFFF );
+        $YoaOset = 0 if ( $YoaOset == 0xFFFFFF );
+
+        # OID is validated, now we only need to handle supported format
+
+        # Get eventually still converted image
+        my $teximage = $container->teximage( $reso ) ;
+
+        # Cancel convertion if image is still converted
+        unless ( $teximage ) {
+            &Debug("Converting $resname resource from $self->{FORMAT} format");
+
+            return ( 254, "Can't process empty $self->{FORMAT} for $resname" )
+                unless ( defined($container->{RESOURCE_BUFFER})
+                and length($container->{RESOURCE_BUFFER}) > 0 );
+
+            my $image = $self->get_image( \$container->{RESOURCE_BUFFER} );
+
+            return ( 254, "Unsupported $self->{FORMAT} format for $resname" )
+                unless ( defined($image) );
+
+            return ( 254, "Can't convert $resname resource" )
+                unless ( $image );
+
+            # Get the TeX name for the inclusion directive
+            my $texname = $flux->resource_texname($resname);
+            return ( 254, "TeX compatible name not set for $resname resource" )
+                unless ( defined($texname) and $texname );
+
+            # Tag texname with resolution
+            my $tag = $reso ;
+            $tag =~ y/0-9/A-J/ ;
+            $texname .= 'at' . $tag ;
+
+            # Get the resource number for the PCL inclusion macro
+            my $number = $flux->resource_number( $resname, $reso ) ;
+            return ( 254, "PCL number not set for $resname resource" )
+                unless ( defined($number) );
+            return ( 254, "Bad $number PCL number for $resname resource" )
+                unless ( $number > -1 and $number < 32768 );
+
+            # Convert image for TeX/LaTeX inclusion
+            $teximage = $self->convert_image( $texname, $image,
+                \$container->{RESOURCE_BUFFER}, $number, $reso );
+            return ( 254, "Can't convert $resname resource for TeX/LaTeX" )
+                unless ( defined($teximage) and $teximage and @{$teximage} );
+
+            # Insert TeX/LaTeX directive definitions to allow inclusion
+            $flux->addline( '{%', @{$teximage}, '}%' ) ;
+
+            # Keep converted image inclusion in container
+            $teximage = $container->teximage( $reso, $texname );
+        }
+
+        # Prepare array of Tex/LaTeX lines
+        my @texlines = ( "{% $teximage inclusion as $resname at $reso dpi" ) ;
+
+        # TODO Offset should be absolute in the AFP standard
+        push @texlines,
+            "\\PAGEPUT{\\XX\\kern$XoaOset\\Xunit}{\\YY\\kern$YoaOset\\Yunit}{" .
+            "\\$teximage}%",
+            "}%" ;
+
+        # Add TeX/LaTeX code to flux for the inclusion
+        $flux->addline(@texlines) ;
+
+    } elsif ( $ObjType == 0x5F ) {
+        return ( 252, "Unsupported Page Segment ObjType found in IOB" );
+
+    } elsif ( $ObjType == 0xBB ) {
+        return ( 252, "Unsupported GOCA Graphics ObjType found in IOB" );
+
+    } elsif ( $ObjType == 0xEB ) {
+        return ( 252, "Unsupported BCOCA Bar Code ObjType found in IOB" );
+
+    } elsif ( $ObjType == 0xFB ) {
+        return ( 252, "Unsupported IOCA Image ObjType found in IOB" );
+
+    } else {
+        return ( 252, "Unsupported ObjType found in IOB ($ObjType)" );
+    }
+
+    return () ;
+}
+
+sub get_image {
+    my $self = shift ;
+    return 0 unless ( exists($self->{FORMAT}) and $self->{FORMAT} );
+
+    my $dataref = shift ;
+    return 0 unless ( defined($dataref) and $dataref );
+
+    if ( $self->{FORMAT} eq 'GIF' ) {
+         return GD::Image->newFromGifData( $$dataref );
+    }
+
+    # No supported format
+    return undef ;
+}
+
+###################### Image convertion to TeX/LaTeX inclusion code
+sub convert_image {
+    my $self = shift ;
+    # We must be called with 4 defined arguments
+    return undef unless ( map { defined($_) and $_ } @_[0..3] == 4 );
+    my $name = shift ;
+    my $image = shift ;
+    my $gifref = shift ;
+    my $number = shift ;
+    my $reso = shift ;
+
+    my ( $width , $height ) = ( $image->width, $image->height );
+
+    # Open TeX/LaTeX global directive declaration with given name
+    my @lines = (
+        "\\global\\def\\" . $name . "{% as " . $self->name . " at $reso dpi"
+        ) ;
+
+    # In case of PDF, we could prepare the resource as PNG image to include
+    my $flux = $self->{FLUX} ;
+    my $pdf = $flux->getEnv('DO_PDF') =~ /^yes$/i ? 1 : 0 ;
+    if ( $pdf ) {
+        # Get the image as PNG with compression
+        my $png = $image->png($PNGCOMPRESSION);
+
+        # Create the PNG file
+        my ( $pngname ) = $flux->getoutbase =~ m|^(.*)/[^/]+$| ;
+        $pngname .= '/' . $name . '.png' ;
+
+        # Add PNG image to resource to clean
+        $flux->toclean( $pngname );
+
+        unless ( open PNG, '>', $pngname ) {
+            &Error("Can't open file $pngname for writing: $!");
+            return 0 ;
+        }
+        binmode(PNG);
+        print PNG $png ;
+        close(PNG);
+
+        # Insert TeX/LaTeX code for PDF image inclusion
+        unshift @lines,
+            "\\ifpdf%",
+            "\\pdfimageresolution" . $reso . "%",
+            "\\pdfximage{$name.png}%",
+            "\\newcount\\ximage$name%",
+            "\\global\\ximage$name=\\pdflastximage%",
+            "\\fi% End pdf inclusion preparation" ;
+
+        # Add TeX/LaTeX for PDF inclusion
+        push @lines,
+            "\\if\\pcloutput0%",
+            "\\ifpdf%",
+            "\\ifx\\ximage$name\\undefined\\else%",
+            "\\message{PNG[" . $self->name . "]}%",
+            "\\pdfrefximage\\ximage$name%",
+            "\\fi\\fi%",
+            "\\else% End pdf case" ;
+    }
+
+    # Handle PCL case
+    my $pcl = $flux->getEnv('DO_PCL') =~ /^yes$/i ? 1 : 0 ;
+    $pcl = $flux->getEnv('DO_VPCL') =~ /^yes$/i ? 1 : 0
+        unless $pcl ;
+
+    if ( $pcl and ! $ONLY_DO_PDF ) {
+        # Create the PCL file
+        my ( $pclname ) = $flux->getoutbase =~ m|^(.*)/[^/]+$| ;
+        $pclname .= '/' . $name . '.pcl' ;
+
+        # Add PCL resource as to be cleaned
+        $flux->toclean( $pclname );
+
+        # Check PCL_RESOLUTION environment with a configuration default
+        my $resolution = $flux->getEnv('PCL_RESOLUTION') || $PCL_RESOLUTION ;
+
+        # Update the width/height resource expected with the defined resolution
+        my $newwidth  = int( $width  * $resolution / $reso ) ;
+        my $newheight = int( $height * $resolution / $reso ) ;
+
+        # Prepare the command to start for PCL resource generation
+        &Debug("Scaling resource from $width to $newwidth in PCL conversion");
+        my $command = sprintf( $GIFTOPCL, $newwidth, $resolution );
+        &Debug("Scaling resource with '$command' command")
+            if $ADVANCED_DEBUGGING ;
+
+        # Finally the PCL flux is output in a file to be included later
+        $command .= " > '$pclname'" ;
+
+        unless ( open PCL, '|' . $command ) {
+            &Error("Can't use '$command' for execution: $!");
+            return 0 ;
+        }
+        print PCL $$gifref ;
+        close(PCL);
+
+        # Insert TeX/LaTeX code for RAW image inclusion
+        unshift @lines,
+            "\\if\\pcloutput1%",
+            # Specify the macro ID to use and start the macro
+            '\\special{pcl5="&f' . $number . 'y0X" ' .
+            # Set the raster resource width/height
+            'pcl5="*r'. $newwidth .'s'. $newheight .'T" ' .
+            "$name.pcl}%", # Include PCL code for the resource
+            '\\special{pcl5="&f1X"}%', # Stop the macro
+            # Set the global TeX/LaTeX definition
+            '\\global\\def\\pclimage' . $name . "{%",
+            '\\special{pcl5="&f0s' . # Store the PCL current position
+            # Specify the macro ID to use, call it and restore the PCL position
+            $number . 'y3x1S"}%',
+            "}\\fi% End pcl inclusion preparation" ;
+
+        # Add TeX/LaTeX for PCL inclusion
+        push @lines,
+            "\\message{PCL[" . $self->name . "]}%",
+            "\\pclimage" . $name . "%" ;
+    }
+
+    # Close TeX/LaTeX if condition if pdf required
+    push @lines, "\\fi% End pcl case" if $pdf ;
+
+    push @lines, "}% End of $name as " . $self->name . " resource" ;
+
+    return \@lines ;
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+( $IDENTS->{&_ID} ) = __PACKAGE__ =~ /(\w+)$/ ;
Index: /A2P/a2p/AFPDS/MODCA/IPS.pm
===================================================================
--- /A2P/a2p/AFPDS/MODCA/IPS.pm	(revision 3)
+++ /A2P/a2p/AFPDS/MODCA/IPS.pm	(revision 3)
@@ -0,0 +1,157 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Class to export Include Page Segment members
+#
+# cf ref #1, p. 99
+#
+
+package AFPDS::MODCA::IPS ;
+
+use strict ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use AFPDS::MODCA::Common ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 1007 $ =~ /([0-9.]+)\s+/ ;
+}
+our $VERSION ;
+our @ISA = ("AFPDS::MODCA");
+our $IDENTS ;
+
+sub _ID { 0xD3AF5F }
+
+sub new {
+    my $class = shift ;
+    &Debug("new " . __PACKAGE__ . " v$VERSION object");
+
+    my $self = {
+        FLUX     => 0,        # Associated flux
+        IDENT    => _ID,      # MO:DCA identity
+        FLAG     => 0,        # MO:DCA flags
+        RESERVED => 0,        # MO:DCA reserved
+        LONG     => 0,        # MO:DCA buffer length
+        BUFFER   => ''        # MO:DCA content buffer
+    };
+
+    return bless $self , $class ;
+}
+
+sub validate {
+    my $self = shift ;
+
+    &UPSTAT('GETSEGMENT');
+    &Debug("Found IPS as LOGO");
+
+    # Check buffer size
+    return ( 251, "Found too short IPS object (" . $self->{LONG} . "<14)" )
+        if ( $self->{LONG} < 14 );
+
+    &Warn("Found IPS Field value with triplets (" . $self->{LONG} . ">14)")
+        if ( $self->{LONG} > 14 );
+
+    # Check FLUX is a Flux object
+    return ( 251, "IPS needs to be used with Flux object" )
+        unless ( ref($self->{FLUX}) =~ /^AFPDS::Flux$/ );
+
+    return () ;
+}
+
+sub create {
+    my $self = shift ;
+
+    my $flux = $self->{FLUX} ;
+    my ( $landscape, $rotation ) = $flux->orientations ;
+
+    my $logoline = '' ;
+    if ( $landscape != $rotation ) {
+        $flux->updateFlux( { ROTSEGMENT=> $landscape } );
+        $logoline = "\\def\\ROTSEGMENT{" . $landscape . "}%\n" ;
+    }
+
+    # Set logoname
+    my $logoname = substr( $self->{BUFFER}, 0, 8 );
+    $logoname = $self->convert( $logoname );
+    return ( 252, "Invalid logoname found" ) unless $logoname ;
+    $logoname = uc( $logoname );
+
+    &UPSTAT('USESEGMENT_' . $logoname);
+
+    # Set segname for TeX/LaTeX coding
+    my $segname = $logoname ;
+    $segname =~ y/0-9/a-j/ ;
+
+    my $logox = $self->get_from_buffer(  8, 3 );
+    my $logoy = $self->get_from_buffer( 11, 3 );
+
+    my ( $xtex, $ytex ) = ( '', '' );
+    unless ( $logox == 0xFFFFFF ) {
+        # This is a signed number
+        $logox -= 0x1000000 if ( $logox > 0x7FFFFF );
+
+        # Check and set X off-set
+        return ( 222, "Found bad IPS X-value ($logox)" )
+            if ( $logox < -32768 or $logox > 32767 );
+
+        # X off-set as TeX code
+        $xtex = sprintf( "%d\\Xunit" , $logox ) ;
+    }
+
+    unless ( $logoy == 0xFFFFFF ) {
+        # This is a signed number
+        $logoy -= 0x1000000 if ( $logoy > 0x7FFFFF );
+
+        # Check and set Y off-set
+        return ( 223, "Found bad IPS Y-value ($logoy)" )
+            if ( $logoy < -32768 or $logoy > 32767 );
+
+        # Y off-set as TeX code
+        $ytex = sprintf( "%d\\Yunit" , $logoy ) ;
+    }
+
+    # If LOGOPATH is not used, then SEGMENT would be find in TeX env
+    my $segpath = $LOGOPATH ? $LOGOPATH . "/" : "" ;
+
+    # Add SEGMENT to logo list
+    $flux->addsegpath( $segpath, $logoname );
+
+    # Keep information on this valid segment after adding its path
+    $flux->updateFlux( { LOGOs => { $logoname => 1 } } );
+
+    # Finish Tex/LaTeX code and add it to logo list
+    $logoline .= "\\SEGMENT{" . $xtex . "}{" . $ytex  . "}{\\" ;
+    $logoline .= "Rotated" if $landscape ;
+    $logoline .= "Segment" . $segname . "}% Logo: $logoname @ $logox x $logoy" ;
+    $flux->newlogo( $logoline );
+
+    unless ($NO_SYSLOG_DEBUG) {
+        # Just to protect '%' from printf interpretation in syslog...
+        $logoline =~ s/%/%%/g ;
+        &Debug("new logo line '$logoline'");
+    }
+
+    return () ;
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+( $IDENTS->{&_ID} ) = __PACKAGE__ =~ /(\w+)$/ ;
Index: /A2P/a2p/AFPDS/MODCA/NOP.pm
===================================================================
--- /A2P/a2p/AFPDS/MODCA/NOP.pm	(revision 3)
+++ /A2P/a2p/AFPDS/MODCA/NOP.pm	(revision 3)
@@ -0,0 +1,84 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Class to export No Operation members
+#
+
+package AFPDS::MODCA::NOP ;
+
+use strict ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use AFPDS::MODCA::Common ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 1007 $ =~ /([0-9.]+)\s+/ ;
+}
+our $VERSION ;
+our @ISA = ("AFPDS::MODCA");
+our $IDENTS ;
+
+sub _ID { 0xD3EEEE }
+
+sub new {
+    my $class = shift ;
+    &Debug("new " . __PACKAGE__ . " v$VERSION object");
+
+    my $self = {
+        FLUX     => 0,        # Associated flux
+        IDENT    => _ID,      # MO:DCA identity
+        FLAG     => 0,        # MO:DCA flags
+        RESERVED => 0,        # MO:DCA reserved
+        LONG     => 0,        # MO:DCA buffer length
+        BUFFER   => ''        # MO:DCA content buffer
+    };
+
+    return bless $self , $class ;
+}
+
+sub validate {
+    my $self = shift ;
+
+    # Just control the autorized size of buffer
+    return ( 251, "Not authorized " . $self->{LONG} . " buffer size" )
+        if ( $self->{LONG} < 0 or $self->{LONG} > 32759 );
+
+    return () ;
+}
+
+sub create {
+    my $self = shift ;
+
+    # Convert buffer
+    my $info = $self->convert ;
+
+    # Strip from bad chars
+    $info =~ s/[\x00-\x1F\x80\x9F]/./g ;
+
+    # Just output in log
+    &Info( sprintf( "%s", $info ) );
+
+    return () ;
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+( $IDENTS->{&_ID} ) = __PACKAGE__ =~ /(\w+)$/ ;
Index: /A2P/a2p/AFPDS/MODCA/OCD.pm
===================================================================
--- /A2P/a2p/AFPDS/MODCA/OCD.pm	(revision 3)
+++ /A2P/a2p/AFPDS/MODCA/OCD.pm	(revision 3)
@@ -0,0 +1,106 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Class to export Object Container Data members
+#
+# cf ref #2, p. 276
+#
+
+package AFPDS::MODCA::OCD ;
+
+use strict ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use AFPDS::MODCA::Common ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 1007 $ =~ /([0-9.]+)\s+/ ;
+}
+our $VERSION ;
+our @ISA = ("AFPDS::MODCA");
+our $IDENTS ;
+
+sub _ID { 0xD3EE92 }
+
+sub new {
+    my $class = shift ;
+    &Debug("new " . __PACKAGE__ . " v$VERSION object");
+
+    my $self = {
+        FLUX     => 0,        # Associated flux
+        IDENT    => _ID,      # MO:DCA identity
+        FLAG     => 0,        # MO:DCA flags
+        RESERVED => 0,        # MO:DCA reserved
+        LONG     => 0,        # MO:DCA buffer length
+        BUFFER   => ''        # MO:DCA content buffer
+    };
+
+    return bless $self , $class ;
+}
+
+sub validate {
+    my $self = shift ;
+
+    &Debug("Found OCD for integrated resource data");
+    &UPSTAT('GET-RESOURCE-DATA');
+
+    # Just control the autorized size of buffer
+    return ( 251, "Not authorized " . $self->{LONG} . " OCD size" )
+        if ( $self->{LONG} < 0 or $self->{LONG} > 32759 );
+
+    # Check FLUX is a Flux object
+    return ( 251, "OCD needs to be used with Flux object" )
+        unless ( ref($self->{FLUX}) =~ /^AFPDS::Flux$/ );
+
+    return () ;
+}
+
+sub create {
+    my $self = shift ;
+
+    if ($self->{LONG}) {
+        my $flux = $self->{FLUX} ;
+
+        my $object = $flux->get_resource ;
+        return ( 252, "No object container available for datas" )
+            unless ( $object );
+
+        my $struct = $object->{STRUCT} || 0 ;
+        return ( 253, "Unexpected '$struct' structure found for container" )
+            unless ( $struct == 0xDC00 );
+
+        # Initialize buffer if not exist
+        $object->{RESOURCE_BUFFER} = ""
+            unless (exists($object->{RESOURCE_BUFFER}));
+
+        # Concatenate current buffers
+        $object->{RESOURCE_BUFFER} .= $self->{BUFFER} ;
+
+    } else {
+        &Debug("Empty object container data found");
+    }
+
+    return () ;
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+( $IDENTS->{&_ID} ) = __PACKAGE__ =~ /(\w+)$/ ;
Index: /A2P/a2p/AFPDS/MODCA/PTX.pm
===================================================================
--- /A2P/a2p/AFPDS/MODCA/PTX.pm	(revision 3)
+++ /A2P/a2p/AFPDS/MODCA/PTX.pm	(revision 3)
@@ -0,0 +1,110 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Class to export Presentation Text Data (PTCA flux) members
+#
+# cf ref #2, p. 309
+#
+
+package AFPDS::MODCA::PTX ;
+
+use strict ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use AFPDS::PTCA ;
+use AFPDS::MODCA::Common ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 1007 $ =~ /([0-9.]+)\s+/ ;
+}
+our $VERSION ;
+our @ISA = ("AFPDS::MODCA");
+our $IDENTS ;
+
+sub _ID { 0xD3EE9B }
+
+sub new {
+    my $class = shift ;
+    &Debug("new " . __PACKAGE__ . " v$VERSION object");
+
+    my $self = {
+        FLUX     => 0,        # Associated flux
+        IDENT    => _ID,      # MO:DCA identity
+        FLAG     => 0,        # MO:DCA flags
+        RESERVED => 0,        # MO:DCA reserved
+        LONG     => 0,        # MO:DCA buffer length
+        BUFFER   => ''        # MO:DCA content buffer
+    };
+
+    return bless $self , $class ;
+}
+
+sub validate {
+    my $self = shift ;
+
+    &UPSTAT('GETPTCA');
+
+    my $ptx = new AFPDS::PTCA( $self->{BUFFER} );
+
+    return ( 251, "Can't convert invalid PTCA flux" )
+        unless ( $ptx->isValid );
+
+    # Check FLUX is a Flux object
+    return ( 251, "IPS needs to be used with Flux object" )
+        unless ( ref($self->{FLUX}) =~ /^AFPDS::Flux$/ );
+
+    # Store PTX only if used
+    $self->{PTX} = $ptx->isValid > 0 ? $ptx : 0 ;
+
+    return () ;
+}
+
+sub create {
+    my $self = shift ;
+
+    # Still return if not used
+    my $ptx  = $self->{PTX} or return () ;
+
+    my $flux = $self->{FLUX} ;
+
+    if ( $flux->getlineindex > 0 ) {
+        # Directly insert if any line exists
+        $flux->addline( $ptx->getTex() ) ;
+
+    } else {
+        # Otherwise this means page is not initialized, so we can add
+        # it to logo def. This case arises when adding line with logos
+        $flux->newlogo( $ptx->getTex() ) ;
+    }
+
+    if ( my $font = $ptx->getFont() ){
+        # PTCA has selected a font, we should handle it
+        $flux->updateFlux( { DefaultTRC => $font } );
+    }
+
+    return () ;
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+( $IDENTS->{&_ID} ) = __PACKAGE__ =~ /(\w+)$/ ;
+
+1 ;
Index: /A2P/a2p/AFPDS/PCL.pm
===================================================================
--- /A2P/a2p/AFPDS/PCL.pm	(revision 3)
+++ /A2P/a2p/AFPDS/PCL.pm	(revision 3)
@@ -0,0 +1,117 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+package AFPDS::PCL;
+
+use strict;
+use integer;
+use File::stat;
+use A2P::Globals;
+use A2P::Syslog;
+
+BEGIN {
+    use Exporter ();
+    our ( $VERSION , @ISA , @EXPORT );
+
+    $VERSION = sprintf "%s", q$Rev: 415 $ =~ /(\d[0-9.]+)\s+/ ;
+
+    @ISA = qw(Exporter);
+    @EXPORT = qw(&validate_pcl5);
+}
+our $VERSION ;
+
+# Sub used to strip PCL5 file generated by dvijl command from
+# some problematic values
+sub validate_pcl5 {
+    my $file = shift;
+    my $len = 20 ;
+    my $esc = chr(27);
+
+    if ($USE_PCLCMD) {
+        &Debug("No PCL5 validation needed as using dvipcl5 command");
+        return 0;
+    }
+
+    if (!defined($file)) {
+        &Error("No file to validate");
+        return 2 ;
+    }
+
+    if (!length($file) or !( -e $file and -f $file and -s $file)) {
+        &Error("Not a valid file name to validate");
+        return 3 ;
+    }
+
+    &Debug("Validating '$file' PCL file");
+
+    # Get size of file
+    my $stat = stat($file);
+    my $size = $stat->size;
+
+    # Opening files for reading
+    open( PCL5, "+<", "$file" )
+        or &Error("Can't open $file: $!"), return 1;
+
+    # Read file in binary mode
+    binmode(PCL5)
+        or &Error("Can't process $file in binary mode, $!"), return 1;
+
+    # Seek to $len bytes from the end of file
+    seek PCL5, -$len , 2
+        or &Error("Unable to seek to the end of $file, $!"), return 1;
+
+    my $buffer = "";
+    read(PCL5,$buffer,$len)
+        or &Error("Unable to read the end of $file, $!"), return 1;
+
+    # Go back to $len bytes from the end of file
+    seek PCL5, -$len , 2
+        or &Error("Unable to seek from the end of $file after able to read the end, $!"), return 1;
+
+    &Error("Bad length read at the end of file"), return 1 if (length($buffer)!=$len);
+
+    my $end = $esc . "E" . $esc . "%-12345X";
+
+    # Strip manual feed request
+    my $manualfeed = $esc . "&l2H" ;
+    $buffer =~ s/$manualfeed\x{0C}?$end/$end/ ;
+
+    # Strip eventually any duplicated page feed, can arised after stripping a manual feed request
+    $buffer =~ s/\x{0C}\x{0C}/\x{0C}/g ;
+
+    if (length($buffer) < $len) {
+        &Debug("$file has been changed after PCL5 validation, updating it");
+        print PCL5 $buffer ;
+        truncate PCL5 , $size - $len + length($buffer)
+            or &Error("Unable to truncate $file after update, $!"), return 1;
+    }
+
+    # Close file
+    close(PCL5)
+        or &Error("Close failed on $file after update, $!"), return 1;
+
+    return 0;
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
Index: /A2P/a2p/AFPDS/PTCA.pm
===================================================================
--- /A2P/a2p/AFPDS/PTCA.pm	(revision 3)
+++ /A2P/a2p/AFPDS/PTCA.pm	(revision 3)
@@ -0,0 +1,285 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Class to implement print object
+#
+
+package AFPDS::PTCA;
+
+use strict;
+use Encode 'from_to';
+use A2P::Globals ;
+use A2P::Syslog;
+use A2P::Tools qw(debugbuffer compute);
+use A2P::Common qw(validate);
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 986 $ =~ /(\d[0-9.]+)\s+/ ;
+}
+our $VERSION ;
+
+# Doc ref. from 'Data Stream and Object Architectures -
+# Presentation Text Object Content Architecture Reference.pdf'
+my %command = (
+    0xE6 => 'DBR' , # Draw B-axis Rule, p. 58
+    0xE4 => 'DIR' , # Draw I-axis Rule, p. 60
+    0xD2 => 'AMB' , # Absolute Move Baseline, p. 51
+    0xD4 => 'RMB' , # Relative Move Baseline, p. 69
+    0xC6 => 'AMI' , # Absolute Move Inline, p. 53
+    0xC8 => 'RMI' , # Relative Move Inline, p. 71
+    0xF0 => 'SCFL', # Set Coded Font Local, p. 77
+    );
+
+# Update table to avoid eval compilation at runtime
+my @keys = keys( %command );
+foreach my $key ( @keys ) {
+    $command{$key+0x100} = eval '\&' . $command{$key} ;
+}
+
+sub new {
+    &Debug("new AFPDS::PTCA v$VERSION");
+    my $class  = shift ;
+
+    my $self = {
+        BUFFER => shift,
+        FONT  =>  ""
+        };
+
+    return bless $self , $class ;
+}
+
+sub isValid {
+    my $self = shift ;
+    # Return validity cached value
+    return $self->{VALIDITY} if (defined($self->{VALIDITY}));
+
+    my $check = &compute( \$self->{BUFFER} , 0 , 1 );
+    # PTX prefix+class pair = 0x2BD3
+    if ( $check != 0x2B or length( $self->{BUFFER} ) < 1 ) {
+        # Skip not used PTX
+        if ( length( $self->{BUFFER} ) == 0 or
+        ( $check == 0 and length( $self->{BUFFER} ) == 1 )) {
+            &Debug("PTX field seems not used");
+            return $self->{VALIDITY} = -1 ;
+
+        } else {
+            &Warn("PTX Field is badly formated (should begin with 0x2B)");
+        }
+        return $self->{VALIDITY} = 0 ;
+    }
+
+    $check = &compute( \$self->{BUFFER} , 1 , 1 );
+    if ( $check != 0xD3 ) {# PTX prefix+class pair
+        &Error("PTX Field is badly formated (should begin with 0x2BD3)");
+        return $self->{VALIDITY} = 0 ;
+    }
+
+    return $self->{VALIDITY} = 1 ;
+}
+
+sub getTex {
+    my $self = shift ;
+    my $TeXCode = "\\PAGEPUT{\\XX}{\\YY}{\\xCP=0pt\\yCP=0pt% PTCA Object\n" ;
+
+    my $cmdlong = 1 ;
+    my $text = 0 ;
+    for ( my $i = 2 ; $i < length( $self->{BUFFER} ) ; $i += $cmdlong ) {
+        if ( $text ) {
+            my $j ;
+            # Found the next operation as end of text
+            for ( $j = $i ; $j < length( $self->{BUFFER} ) ; $j ++ ) {
+                last if ( &compute( \$self->{BUFFER} , $j , 2 ) == 0x2BD3 ) ;
+            }
+            $cmdlong = $j - $i ;
+            my $buffer = substr( $self->{BUFFER} , $i , $cmdlong ) ;
+            &debugbuffer( $buffer );
+            &from_to( $buffer , $FROM_CONVERT , $TO_CONVERT ) if ($DO_CONVERT);
+            # Second argument is used to disable space stripping in &validate
+            &validate( \$buffer , 1 );
+            &Debug("Got text '$buffer'");
+            $TeXCode .= "\\PTCATEXT{$buffer}%\n" ;
+            $cmdlong += 2 ; # To skip the prefix+class pair
+            $text = 0 ;
+            next ;
+        }
+        $cmdlong = &compute( \$self->{BUFFER} , $i   , 1 );
+        my $type = &compute( \$self->{BUFFER} , $i+1 , 1 );
+        if ( defined($command{$type & 0xFE})) {
+            my $Type = $type & 0xFE ;
+            &Debug("Got command type $command{$Type} with length $cmdlong");
+            $TeXCode .= $command{$Type + 0x100}( $self, $i+2, $cmdlong);
+            $TeXCode .= "%\tis PTCA $command{$Type}\n" ;
+        } else {
+            &Warn(sprintf(
+                "Got unsupported PTCA command type 0x%02X with length %d",
+                $type, $cmdlong ));
+        }
+        # End of command: Maybe some text is comming
+        $text = 1 if ($type & 1) == 0 ;
+    }
+
+    return $TeXCode . "}%" ;
+}
+
+sub DBR {
+    my ( $self , $k , $long ) = @_ ;
+    my $rlength = $self->getlen( $k ) ;
+    my $rwidth  = 1 ;
+    if ( $long == 7 ) {
+        $rwidth = $self->getlen( $k + 2 ) ;
+        $rwidth /= 2 ^ &compute( \$self->{BUFFER} , $k+4 , 1 );
+    }
+    my $offset = "" ;
+    my $correction = "\\advance\\xCP by" . $self->PELS( abs($rwidth) ) ;
+    if ( $rlength < 0 ) {
+        $rlength = abs($rlength) ;
+        $offset .= "\\advance\\yCP by-" . $self->PELS( $rlength ) . "%\n" ;
+        $correction .= "\\advance\\yCP by" . $self->PELS( abs($rlength) ) ;
+    }
+    if ( $rwidth < 0 ) {
+        $rwidth = abs($rwidth) ;
+        $offset .= "\\advance\\xCP by-" . $self->PELS( $rwidth ) . "%\n" ;
+    }
+    &Debug("Draw B-axis Rule with length $rlength PELS and width $rwidth PELS");
+    return $offset . "\\PTCAPUT{\\vrule height" . $self->PELS( $rlength )
+        . " depth0pt width" . $self->PELS( $rwidth ) . "}" . $correction ;
+}
+
+sub DIR {
+    my ( $self , $k , $long ) = @_ ;
+    my $rlength = $self->getlen( $k ) ;
+    my $rwidth  = 1 ;
+    if ( $long == 7 ) {
+        $rwidth = $self->getlen( $k + 2 ) ;
+        $rwidth /= 2 ^ &compute( \$self->{BUFFER} , $k+4 , 1 );
+    }
+    my $offset = "" ;
+    my $correction = "\\advance\\yCP by" . $self->PELS( abs($rwidth) ) ;
+    if ( $rlength < 0 ) {
+        $rlength = abs($rlength) ;
+        $offset .= "\\advance\\xCP by-" . $self->PELS( $rlength ) . "%\n" ;
+        $correction .= "\\advance\\xCP by" . $self->PELS( $rlength ) ;
+    }
+    if ( $rwidth < 0 ) {
+        $rwidth = abs($rwidth) ;
+        $offset .= "\\advance\\yCP by-" . $self->PELS( $rwidth ) . "%\n" ;
+    }
+    &Debug("Draw I-axis Rule with length $rlength PELS and width $rwidth PELS");
+    return $offset . "\\PTCAPUT{\\vrule height" . $self->PELS( $rwidth )
+        . " depth0pt width" . $self->PELS( $rlength ) . "}" . $correction ;
+}
+
+sub AMB {
+    my ( $self , $k , $long ) = @_ ;
+    my $pos = $self->getlen( $k ) ;
+    &Debug("Set position along B-axis to $pos PELS");
+    return "\\yCP=" . $self->PELS( $pos ) ;
+}
+
+sub RMB {
+    my ( $self , $k , $long ) = @_ ;
+    my $move = $self->getlen( $k ) ;
+    &Debug("Move along B-axis for $move PELS");
+    return "\\advance\\yCP by" . $self->PELS( $move ) ;
+}
+
+sub AMI {
+    my ( $self , $k , $long ) = @_ ;
+    my $pos = $self->getlen( $k ) ;
+    &Debug("Set position along I-axis to $pos PELS");
+    return "\\xCP=" . $self->PELS( $pos ) ;
+}
+
+sub RMI {
+    my ( $self , $k , $long ) = @_ ;
+    my $move = $self->getlen( $k ) ;
+    &Debug("Move along I-axis for $move PELS");
+    return "\\advance\\xCP by" . $self->PELS( $move ) ;
+}
+
+sub getFont {
+    my $self = shift ;
+    return $self->{FONT} ;
+}
+
+sub SCFL {
+    my ( $self , $k , $long ) = @_ ;
+    my $FontRef = "" ;
+    my $font = &compute( \$self->{BUFFER} , $k , 1 ) ;
+
+    unless ( -- $font =~ /^\d+$/ ) {
+        &Error("Unsupported '$font' SCFL PTCA object");
+        $font = 0 ;
+    }
+
+    for ( split( // , $font ) ) {
+        $FontRef .= chr( 65 + $_ ) ;
+    }
+
+    &Debug("PTCA SCFL selects font TRC '$FontRef'");
+
+    return $self->{FONT} = "\\FONtTrc" . $FontRef ;
+}
+
+sub PELS {
+    my ( $self , $PELS ) = @_ ;
+    # PEL size: 0.501875 for 72.27/144, 0.301125 for 72.27/240, 0.3 for 72/240
+    my $pt_by_PELS = 0.301125 ; # units = pt/pels
+    my $P = 6 ; # Precision: how many numbers after point
+    my $value = sprintf("%.${P}f" , $PELS * $pt_by_PELS );
+    $value =~ s/.0{$P}$// ;
+    $value =~ s/0+$// if ( $value != 0 );
+    &Debug("${PELS} PELS converted to ${value} pt");
+    return $value . "pt" ;
+}
+
+sub getlen {
+    my ( $self , $index ) = @_ ;
+    my ( $first , $second ) = (
+        ord( substr($self->{BUFFER} , $index     , 1 )) ,
+        ord( substr($self->{BUFFER} , $index + 1 , 1 ))
+        );
+
+    my $len = $first * 256 + $second;
+
+    $len -= 0x10000 if ( $len > 0x7FFF ); # This is a signed number
+    &Debug(sprintf("Len %X%X converted to $len",$first,$second));
+
+    return $len ;
+}
+
+sub DESTROY {
+    my $self = shift;
+    my $err  = shift;
+
+    # Free arrays memory
+    map { $self->{$_} = () if (ref($self->{$_}) eq 'ARRAY' ) } keys(%{$self});
+
+    if (defined($err)) {
+        &Error("PTCA object $self->{OUTFILE} destroyed with error #" . $err);
+    } else {
+        &Debug("PTCA object $self->{OUTFILE} destroyed");
+    }
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
Index: /A2P/a2p/AFPDS/afpds2tex.pm
===================================================================
--- /A2P/a2p/AFPDS/afpds2tex.pm	(revision 3)
+++ /A2P/a2p/AFPDS/afpds2tex.pm	(revision 3)
@@ -0,0 +1,1012 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+package AFPDS::afpds2tex;
+
+use strict ;
+use Encode 'from_to' ;
+use Time::HiRes qw( gettimeofday tv_interval usleep );
+use File::stat ;
+use A2P::Globals ;
+use A2P::Syslog ;
+use A2P::Common ;
+use A2P::Com    qw( GetCom comINF comREQ comFILE );
+use A2P::Tools  qw( debugbuffer compute mychomp myreadline ) ;
+use AFPDS::Flux ;
+use AFPDS::ControlRecord ;
+use A2P::XML ;
+use A2P::JobStatus 'a2pjobstate' ;
+
+BEGIN {
+    our $VERSION = sprintf "%s", q$Rev: 1023 $ =~ /([0-9.]+)\s+/ ;
+}
+our $VERSION ;
+
+# Files handles & generation flag
+my ( $TexFile, $ArchFile, $AfpFile, $LCKNAME, $AFPDSFILE );
+my $GenFlag = 0 ;
+my $ErrFlag = 0 ;
+my $AfpName = "";
+my $Job     = "";
+my $self    = 0 ;
+my $file    = 0 ;
+my $mtime   = 0 ;
+
+# @skip will be used to continue an afp job when an error occurs on a sub job
+# It should be reset to () at each new job
+my @skip = () ;
+
+my $RateTimer = [] ;
+my $afpbuffer = "" ;
+
+my $min_conv_time = 0 ;
+
+sub _job_tag {
+    return $Job ? "$Job".($file?"-$file":"").": " : ""
+}
+
+# Function to open TeX file and his shell environment file for writing
+sub OpenFiles {
+    my $filename = $_[1] ;
+
+    open($TexFile, ">$filename.tex")
+        or &Abort(107, "$filename.tex",  "$!"), return 0;
+
+    $LCKNAME = "$filename.tex.LCK" ;
+    open(LCK, ">$LCKNAME")
+        or &Abort(107, $LCKNAME,  "$!"), return 0;
+
+    open($ArchFile, ">$filename.arch")
+        or &Abort(107, "$filename.arch", "$!"), return 0;
+
+    return 1 unless ( $PARALLELE_VALIDATION or $KEEP_AFPJOB );
+
+    open($AfpFile,  ">$filename.afp")
+        or &Abort(107, "$filename.afp" , "$!"), return 0;
+
+    return 1 ;
+}
+
+# Function to close TeX file and his shell environment file
+sub CloseFiles {
+    close($TexFile)  if (defined($TexFile));
+    close($ArchFile) if (defined($ArchFile));
+    close($AfpFile)  if (defined($AfpFile));
+    if (defined($LCKNAME) and -e $LCKNAME) {
+        close(LCK);
+        unlink $LCKNAME ;
+    }
+    $GenFlag = 0 ;
+}
+
+# Arguments:
+# 1 - The texname to process
+# 2 - AFPDS file to process
+sub ConvertFile {
+       $self      = shift ;
+    my $texbase   = shift ;
+    my $afpdsfile = shift ;
+       $Job       = shift ; # Current job name for queueing announcement
+    my $startpos  = shift || 0 ; # The start position in AFP file for splitting
+
+    # Forget any previous status
+    $ErrFlag = 0 ;
+    @skip = () ;
+
+    # Same computation as in SpoolManager module
+    ( $AfpName ) = $afpdsfile =~ $AFPNAME_REGEX ;
+    &Debug("Afpname set to '$AfpName' from Texbase '$afpdsfile'");
+
+    # First job state update in spool
+    &a2pjobstate( $Job , 2 , '.', { JOBID => $Job } )
+         or &Info("Can't initialize job status at step 2 with JOBID $Job");
+
+    $afpdsfile = $AFPSPOOL . '/' . $afpdsfile
+        unless ( -e $afpdsfile );
+
+    # Provided texbase must not be an existing folder
+    return &Abort( 119, $texbase) if ( -d $texbase );
+
+    # Create texbase as folder
+    mkdir $texbase , 0775
+        or return &Abort( 106, $texbase, "$!");
+
+    # Here, texbase will be a folder to delete, so inform JobManager of it
+    $self->Return( $Job , $texbase );
+
+    # Opening files for reading
+    open($AFPDSFILE, "<", "$afpdsfile")
+        or return &Abort( 107, $afpdsfile, "$!");
+
+    # Read AFPDS files in binary mode
+    binmode($AFPDSFILE)
+        or return &Abort( 108, $afpdsfile, "$!");
+
+    &Debug("Starting AFPDS conversion of $afpdsfile to $texbase folder");
+
+    ############################################################################
+    # Check if records are terminated by CR-LF:
+    # search for pattern 0x0D0A in the last 10 chars of afpds file
+    ############################################################################
+    my ( $readmode , $buffer , $EOF , $inXML ) = ( 0 , "" , 0 , 0 ) ;
+    {
+        my ( $EOL , $offset ) = ( 0 , 9 );
+
+        # 1. Check file contents greater than 7 chars, or this is probably
+        #    a corrupted file
+        seek $AFPDSFILE , 0 , 2 ;
+        return &Abort(124, $afpdsfile) if ( tell($AFPDSFILE) <= 7 );
+
+        # 2. Load the last 10 chars in the buffer
+        seek $AFPDSFILE , -10 , 2 ;
+        return &Abort(109, $afpdsfile, "$!")
+            if ( read($AFPDSFILE , $buffer , 10) != 10);
+
+        # 3. Scan loaded buffer for 0x0D0A string starting from offset 8
+        #    in the buffer
+        while ( $offset-- > 0 ) {
+            $EOL = &compute( \$buffer , $offset , 2 );
+            $readmode += 2 , last if ( $EOL == 0x0D0A );
+        }
+
+        &Debug(sprintf(
+            "Readmode is $readmode as found CRLF=0x%04x at offset %d",
+            $EOL,$offset));
+
+        # Keep End of File information
+        $EOF = tell($AFPDSFILE);
+    }
+
+    # Get file time creation
+    my $stat = stat($afpdsfile);
+    $mtime = $stat->mtime() ;
+
+    ############################################################################
+    # Rewind file to startpos (beginning by default)
+    seek $AFPDSFILE , $startpos , 0 ;
+
+    ############################################################################
+    #
+    # Read the AFPDS file
+    #
+    ############################################################################
+    my ( $long , $char , $cctrl , $tmp , $maxrepeat );
+    $file = 1 ;
+    $afpbuffer = "" ;
+
+    # Timer to get a chrono on the current conversion
+    $RateTimer = [ &gettimeofday() ] ;
+
+    # Set minimum conversion time (used for big jobs to limit convertion rate)
+    $min_conv_time = $USLEEP ;
+    # MAX_CONV_RATE is a maximum sub-job number to generate by seconds
+    $min_conv_time = 1_000_000 / $MAX_CONV_RATE
+        if ($MAX_CONV_RATE);
+
+    # Set chrono to return progression status when required
+    my @StartTime = &gettimeofday();
+    my $tv_timing = $CONV_STATUS_TIMING ;
+
+    $buffer = getc( $AFPDSFILE ) ;
+    while ( defined( $buffer ) and ! eof($AFPDSFILE) ) {
+
+        # Update afpbuffer
+        $afpbuffer .= $buffer ;
+
+        #  Manage the 0x5A char
+        if ( ord( $buffer ) == 0x5A and ! $inXML ) {
+
+            #  Read the field length
+            read $AFPDSFILE , $buffer , 8 ;
+            $long = &compute( \$buffer , 0 , 2 ) ;
+
+            # Update afpbuffer
+            $afpbuffer .= $buffer ;
+
+            # Keep preamble for debugging
+            my $preamble = $buffer ;
+
+            # Abort if field is too short
+            &Abort(114,$long) if ( $long < 8 );
+
+            # Compute other attributes
+
+            # cf doc IBM AFP - programming guide and line data ref - 54438842
+            my $ident    = &compute( \$buffer , 2 , 3 ) ;
+            my $flag     = &compute( \$buffer , 5 , 1 ) ;
+            my $reserved = &compute( \$buffer , 6 , 2 ) ;
+
+            # In case file is line delimited, then $readmode = 2, so we
+            # need to check and found 2 more chars to be CRLF
+            $long -= 8 - $readmode ;
+
+            &Debug(sprintf("Long is %d, Ident is 0x%x and Flag is 0x%x",
+                $long, $ident, $flag ));
+
+            if ( $long > 0 ) {
+                # Read the value of $ident
+                read $AFPDSFILE , $buffer , $long ;
+
+                # Update afpbuffer
+                $afpbuffer .= $buffer ;
+
+                # Some lines are full filled with spaces...
+                if ( $readmode > 0 ) {
+                    # The value should end with 0x0D0A,
+                    # else read until end of line...
+                    $tmp = &compute( \$buffer , -2 , 2 );
+                    if ( $tmp != 0x0D0A ) {
+
+                        # Read till the real end of line
+                        my $plus = &myreadline( \*$AFPDSFILE , \$buffer );
+
+                        # Update afpbuffer
+                        $afpbuffer .= substr($buffer,-$plus) if $plus ;
+
+                        $long += $plus ;
+
+                        # Definitive check
+                        $tmp = &compute( \$buffer , -2 , 2 );
+                         if ( $tmp != 0x0D0A ) {
+                            &debugbuffer( $preamble . $buffer );
+                             &Abort(110,$tmp);
+                        }
+                    }
+
+                    $long -= &mychomp( \$buffer, 'keep spaces' ) ;
+                }
+
+                # Check we read as byte as we need
+                if ( length($buffer) != $long ) {
+                    &debugbuffer($preamble . $buffer);
+                    &Abort(111,length($buffer),$long);
+                }
+
+            } else {
+                # Reset the buffer if nothing has been needed to read
+                $buffer = "" ;
+            }
+
+            if (defined($self->{AFPDS})) {
+                &debugbuffer( $preamble . $buffer );
+
+                my @params = ( $ident, $flag, $reserved, $long, $buffer,
+                    $texbase );
+                # Don't try to analyse 5A record if @skip is not empty
+                &Abort( 200, $self->{AFPDS}->geterror() )
+                    if ( ! @skip and $self->{AFPDS}->got5Achar(@params) < 0 );
+
+            } else {
+                # Rise abort if we got 0x5A AFP record without AFPDS Flux
+                # Object initialization
+                &Abort(3);
+            }
+
+            # Check got5Achar didn't rise an error
+            &Abort( 118, $ident, $flag, $reserved, $long,
+                join('',map { sprintf("%X",$_) } split(//,$buffer) ))
+                    unless (defined($self->{AFPDS}));
+
+        ########################################################################
+        ##  Manage the 0x7B char '#' for C930 control record (or RC)          ##
+        ########################################################################
+        } elsif ( ord( $buffer ) == 0x7B or $inXML ) {
+
+            my ( $begin , $Type ) = ( $buffer , "" );
+            read( $AFPDSFILE , $Type , 3 ) ;
+
+            # And check this is really a numbered RC
+            read( $AFPDSFILE , $buffer , 1 ) ;
+
+            # Update begin to later update afpbuffer
+            my $rawtype = $Type . $buffer ;
+
+            # Must found another '#' as format validation if not in XML reading
+            &Abort(112,$Type)
+                unless ( $inXML or ord( $buffer ) == 0x7B );
+
+            &from_to( $Type , $FROM_CONVERT , $TO_CONVERT ) if ($DO_CONVERT);
+
+            my $afpds = $self->{AFPDS} ;
+
+            # Generate a print if still after the first print analysis
+            if ( ! $inXML and $GenFlag
+            and ( $Type eq '001' or $Type eq '100' )) {
+                if (defined($afpds)) {
+                    &Debug("File#${file}: Start TeX file generation");
+
+                    # Output this TeX file or rise an ABTERM
+                    unless ( @skip or &generateTeX ) {
+                        &Abort(103, $file, defined($self->{RC}->{$Type}) ?
+                            $self->{RC}->{$Type}->getoutfile()
+                            :
+                            "with undefined '$Type' RC"
+                            );
+                    }
+
+                    # Increment file index
+                    $file ++ ;
+
+                } else {
+                    # Abort if AFPDS object has vanished
+                    &Abort(4) ;
+                }
+            }
+
+            # Initialise a new AFPDS flux only on record Type 001 or 100
+            if (! $inXML and ( $Type eq '001' or $Type eq '100' )) {
+                &UPSTAT('GETNEWJOB');
+
+                # Reset skipping array to try another document
+                if (@skip) {
+                    # Starting new job after ABTERM
+                    &Abort(500,$file); # Warn we are trying to start a new job
+                    @skip = () ;
+                }
+
+                # Destroy last afpds object if needed and create new one
+                delete $self->{AFPDS} if (defined($afpds));
+                undef $afpds ;
+
+                &Debug("Initializing AFPDS objects");
+                $afpds = new AFPDS::Flux( $afpdsfile , $self , $Job );
+
+                # And don't forget to keep a copy
+                $self->{AFPDS} = $afpds ;
+            }
+
+            # Update job index in flux in case it has changed
+            $afpds->setjobindex( $file );
+
+            # Still check AFPDS Flux object exists
+            &Abort(117,$Type) unless (defined($afpds));
+
+            my $RC ;
+            my ( $tA , $tB ) = ( ord($begin) == 0x7B , ord($buffer) == 0x7B ) ;
+
+            # Continue last not sized RC unless it is the stop one
+            if ( $inXML and
+                (( $inXML eq '200' and ! ( $Type eq '201' and $tA and $tB )) or
+                ( $inXML eq '201' and ! ( $Type eq '202'  and $tA and $tB ))))
+            {
+                &Debug("In XML $inXML: Type would be '" . ( $tA ? '#' : '.' ) .
+                    $Type . ( $tB ? '#' : '.' ) . "'");
+
+                # Still reading an XML, seek to beginning of line to avoid
+                # missing an EOL if the begin string
+                seek $AFPDSFILE, -5 , 1 ;
+
+                # Type has been saved in inXML
+                $Type = $inXML ;
+
+                # Get last created RC
+                $RC = $self->{RC}->{$Type} ;
+
+            } else {
+                # Update afpbuffer
+                $afpbuffer .= $rawtype ;
+
+                # Destroy last control record if needed and create new one
+                delete $self->{RC}->{$Type} if (defined($self->{RC}->{$Type}));
+
+                # Get new RC object
+                $RC = new AFPDS::ControlRecord( $Type,$texbase,$AfpName,$file );
+
+                &Debug("Found a control record type '$Type'");
+            }
+
+            # Check object creation
+            &Abort(115, $file, $Type , $texbase ) unless (defined($RC));
+
+            $buffer = "" ;
+
+            # Initialization should return the length of the record control
+            # Else it should return 0 to stop reading as record type is unknown
+            $tmp = defined($RC) ? $RC->get_required_size() + $readmode : 0 ;
+            &Abort(113,$tmp,$Type) unless ($tmp);
+
+            # Read now ControlRecord and analyse it
+            if ( $tmp > 0 and read( $AFPDSFILE, $buffer, $tmp ) == $tmp ) {
+
+                &debugbuffer($buffer);
+                &Abort(300,$Type,$RC->geterror())
+                    if ( defined($RC) and $RC->init( $buffer ) < 0 );
+
+                # Check initialization is done
+                &Abort( 116, $Type, sprintf( "%02X" x length($buffer),
+                    map { ord } split( //, $buffer ) ) )
+                        unless (defined($RC));
+
+                # Set job_tag for this RC library
+                $RC->job_tag($Job);
+
+                # Check if we have reached a afpds splitting event
+                if ( ! @skip and $RC->can_split_job() ) {
+                    # Compute the pos in file for the next job to convert
+                    my $pos = tell($AFPDSFILE) - length($afpbuffer)
+                         - length($buffer);
+
+                    # Get a tag
+                    my @split_tags = $RC->get_split_tags ;
+
+                    # Set this job is the last of a split event
+                    $afpds->updateEnv( {
+                        # Set SPLIT_FILE with first position in file and length
+                        SPLIT_FILE  => $startpos . ':' . $pos,
+                        SPLIT_TAG   => $split_tags[0],
+                        SPLIT_TAG2  => $split_tags[1]
+                        } );
+
+                    # Skip the rest to leave as a splitting event
+                    push @skip, 'splitted' ;
+
+                    # Finish that job
+                    last ;
+                }
+
+                if ( ! @skip and ($Type eq '001' or $Type eq '100')) {
+
+                    my $pagedef = $RC->getpagedef() ;
+
+                    &UPSTAT('USEPAGEDEF_' . $pagedef );
+
+                    # Load the perl Library for the PAGEDEF only on record
+                    # Type 001 or 100
+                    my $loadlib = "perllib::p1" . lc( $pagedef );
+
+                    # Abort if we won't be able to load perl module
+                    if ($pagedef) {
+                        &Abort(104,$pagedef,$loadlib)
+                            unless ( grep {
+                                -s $_ . '/perllib/p1' . lc( $pagedef ) . '.pm'
+                            } @INC );
+
+                    } else {
+                        &Abort(6);
+                    }
+
+                    unless (@skip) {
+                        &Debug("Loading library with '$loadlib' evaluation");
+                        eval "use " . $loadlib ;
+
+                        $afpds->setpagedef(   $pagedef );
+                        $afpds->setpclcond(   $RC->ispcloutput() );
+                        $afpds->setformdef(   $RC->getformdef()  );
+                        $afpds->setoutfile(   $RC->getoutfile()  );
+                        $afpds->setTRCforTeX( $RC->getTRCforTeX());
+
+                        &Debug("Perl library loaded");
+                    }
+
+                    # Close previous file handles if it's not the first job
+                    $self->CloseFiles if ($GenFlag);
+                    $GenFlag = $self->OpenFiles( $RC->getoutfile() );
+                }
+
+                unless (@skip) {
+                    # Env is updated in Flux and will be returned to JobManager
+                    # when completly analysed
+                    $afpds->updateEnv( $RC->getenv() );
+
+                    # Update ArchFile with RECORD content when necessary
+                    local $\ = "\n" ;
+                    print $ArchFile $RC->getRecord
+                        if (defined($ArchFile) and $RC->getRecord());
+
+                    # Keep a record copy in our RC hash
+                    $self->{RC}->{$Type} = $RC ;
+                }
+
+            # Handle not sized Control Record type 200-202
+            } elsif ($tmp < 0 and $Type =~ /^20[0-2]$/) {
+
+                my $line = "" ;
+                # Read till the end of line
+                &myreadline( \*$AFPDSFILE , \$line );
+
+                # Update afpbuffer (first char always added at loop begining)
+                $afpbuffer .= substr($line,($inXML and $Type eq '201')?1:0) ;
+
+                &mychomp( \$line );
+
+                # Check record
+                if ( $Type eq '202' ) {
+                    # Stopping an input
+
+                    # Forget any information just behind RC 202 string
+                    if ($line !~ /^$/) {
+                        &from_to( $line , $FROM_CONVERT , $TO_CONVERT )
+                            if ($DO_CONVERT);
+                        &Info(_job_tag."RC 202 tagged with '$line'");
+                    }
+
+                    # Check last record 100 to set the PDF name and service flag
+                    &Abort(120, $Type , 100)
+                        unless (defined($self->{RC}->{100}));
+
+                    # Check last record 200 to get the working folder
+                    &Abort(120, $Type , 200)
+                        unless (defined($self->{RC}->{200}));
+
+                    # Check base directory availability for pdf file
+                    my $base = @skip ? undef : $self->{RC}->{100}->getbase ;
+                    &Abort(122, $base)
+                        unless ( defined($base) and $base and -d $base );
+
+                    my $outbase = $base . '/' . $LOCKID . '_' . $Job ;
+                    my $env = {
+                        'PDFFILE'     => $outbase . "-$file.pdf",
+                        'XML_A2P'     => $outbase . "_a2p-$file.xml",
+                        'XML_CONTENT' => $outbase . "_service-$file.xml"
+                    } ;
+
+                    # Update a2p xml attributs before saving
+                    my @attribut = ( pdf => $env->{PDFFILE} );
+                    unless (@skip) {
+                        $self->{RC}->{200}->set_a2p_attribut(@attribut)
+                            or &Abort(123 , @attribut);
+                    }
+
+                    @attribut = ( file => $env->{XML_CONTENT} );
+                    unless (@skip) {
+                        $self->{RC}->{200}->set_a2p_attribut(@attribut)
+                            or &Abort(123 , @attribut);
+                    }
+
+                    # Save A2P xml
+                    unless (@skip) {
+                        $self->{RC}->{200}->save_a2pxml_file($env->{XML_A2P})
+                            or &Abort(121 , 200, $env->{XML_A2P});
+                    }
+
+                    # Check last record 201 to save the content
+                    &Abort(120, $Type , 201)
+                        unless (defined($self->{RC}->{201}));
+
+                    # Save RC 201 content
+                    unless (@skip) {
+                        my $content = $env->{XML_CONTENT} ;
+                        $self->{RC}->{201}->save_a2pxml_file($content)
+                            or &Abort( 121 , 201, $content );
+                    }
+
+                    # Tag Flux as e-service and not arch
+                    &Debug("Updating env to handle content and a2p xml files");
+                    $afpds->updateEnv( $env )
+                        unless (@skip);
+
+                    &Debug("Service is ready to handle E-Service request");
+                    # Release inXML flag
+                    $inXML = 0 ;
+
+                } elsif ( $Type eq '201' ) {
+                    if ($inXML) {
+
+                        &from_to( $line , $FROM_CONVERT , $TO_CONVERT )
+                            if ($CONVERT_CONTENT_FILE and $DO_CONVERT);
+
+                        # Add EOL to line
+                        $line .= "\n" ;
+
+                        # Add the complete line to content
+                        $RC->addcontentref( \$line ) unless (@skip);
+                        &Debug("Added '$line' to content file");
+
+                    } else {
+                        # Forget any information just behind RC 201 string
+                        if ($line !~ /^$/) {
+                            &from_to( $line , $FROM_CONVERT , $TO_CONVERT )
+                                if ($DO_CONVERT);
+                            &Info(_job_tag."RC 201 tagged with '$line'");
+                        }
+
+                        # Flag we are inXML handling
+                        $inXML = $Type ;
+                    }
+
+                } elsif ( $Type eq '200' ) {
+                    # Check last record 100 to get the working folder
+                    &Abort(120, $Type , 100)
+                        unless (defined($self->{RC}->{100}));
+
+                    unless (@skip) {
+                        my $basefile = $self->{RC}->{100}->getoutfile() ;
+
+                        # Update
+                        $line = $begin . $line if $inXML ;
+                        &from_to( $line , $FROM_CONVERT , $TO_CONVERT )
+                            if ($DO_CONVERT);
+
+                        $RC->seta2pxml( $line , $basefile );
+
+                        # Tag Flux as e-service
+                        unless ($inXML) {
+                            &Debug("Updating env with expected values");
+                            $afpds->updateEnv( {
+                                DO_ESERVICE => 'yes',
+                                DO_PDF      => 'yes',
+                            } );
+                        }
+
+                        # Flag we are inXML handling if not complete and valid
+                        $inXML = $RC->a2pxml_is_valid() || $Type ;
+
+                        # Remark: service name '200' is an error as prohibited
+                        #         (checked in XML.pm)
+                        if ($inXML and $inXML ne $Type) {
+                            &Debug("Updating env with requested service");
+                            $afpds->updateEnv( {
+                                E_SERVICE => $inXML
+                            } );
+
+                            # Release inXML flag
+                            $inXML = 0 ;
+                        }
+                    }
+                }
+
+                # Keep a record copy in our RC hash
+                $self->{RC}->{$Type} = $RC unless (@skip);
+
+            } else {
+                # Bad length read for that record
+                &debugbuffer($buffer);
+                &Abort(102,$Type);
+            }
+
+            # Update afpbuffer
+            $afpbuffer .= $buffer ;
+
+        # End of ControlRecord management
+
+        } else {
+            # This is a standard line, first char is the control char
+            $cctrl = $buffer ;
+            &from_to( $cctrl , $FROM_CONVERT , $TO_CONVERT ) if ($DO_CONVERT);
+            &Debug("Found standard line with control char <$cctrl>");
+
+            # The next char is used to select TRC font
+            read( $AFPDSFILE , $char , 1 );
+
+            # Update afpbuffer
+            $afpbuffer .= $char ;
+
+            # Check AFPDS Flux is defined
+            if (defined($self->{AFPDS})) {
+
+                # ErFo001 Fix: Select TRC font
+                $self->{AFPDS}->selectTRCfont( ord($char) )
+                    unless (@skip);
+
+                # Read the rest of the line
+                $buffer = "";
+                $long = &myreadline( \*$AFPDSFILE , \$buffer );
+
+                # Update afpbuffer
+                $afpbuffer .= $buffer ;
+
+                $tmp = &compute( \$buffer , -2 , 2 );
+                if ( $tmp != 0x0D0A ) { # Buffer must end with 0x0D0A
+                    &debugbuffer( $buffer );
+                    &Abort(101,$tmp);
+                }
+
+            } else {
+                &Abort(5);
+            }
+
+            &mychomp( \$buffer );
+            $long = length( $buffer ) ;
+
+            &from_to( $buffer , $FROM_CONVERT , $TO_CONVERT ) if ($DO_CONVERT);
+
+            # Compute the new AFP line
+            $self->{AFPDS}->afpline( $cctrl , $buffer )
+                unless (@skip);
+        }
+
+        my $currentpos  = tell($AFPDSFILE) ;
+        my $currenttime = &tv_interval(\@StartTime) ;
+
+        # Return convertion status after required timing
+        if ( $currenttime >= $tv_timing ) {
+            my $fileratio = $currentpos/$EOF ;
+
+            # Compute convertion ratio
+            my $ratio = sprintf("%d",$fileratio*100);
+
+            # Compute termination estimation
+            my $remain = sprintf("%.1f",$currenttime/$fileratio-$currenttime);
+            &Debug("Convertion done at $ratio%, should finish in $remain s");
+
+            # Return information to JobManager
+            $self->Return( $Job => &GetCom( comINF ,
+                'AFP2TeX Conversion status' =>
+                    "$ratio% done, $remain sec remaining" ));
+
+            # Update job state in spool
+            &a2pjobstate( $Job, 2, '.' , { STATUS => $ratio.'%' })
+                or &Info("Can't update status conversion progress to $ratio%");
+
+            # Update next timing report
+            $tv_timing += $CONV_STATUS_TIMING ;
+        }
+
+        &Debug("Loop at AFPDS file off-set " . sprintf("%Xh",$currentpos) .
+            ($inXML?" in not sized RC '$inXML'":""));
+
+        $buffer = getc( $AFPDSFILE ) ;
+
+    } # End while read file
+
+    &Debug("File#" . $file . ": Last TeX file generation");
+
+    # Output last converted TeX file
+    &Abort(2) unless ( @skip or &generateTeX );
+
+    # Keep stats on conversion rate
+    my $tv_interval = &tv_interval($RateTimer) ;
+    &MAXSTAT('CONV-RATE',int( 100 * $file / $tv_interval ) / 100)
+        if ($tv_interval);
+
+ABORTED_FILE:
+    # Freeing objects
+    delete $self->{AFPDS}
+        if (defined($self->{AFPDS}) and ! $self->{AFPDS}->issplitted());
+    delete $self->{RC} if (  defined($self->{RC}) );
+
+    # Reset vars
+    $file = 0 ;
+
+    return $ErrFlag ? &End($ErrFlag) : &End(0, "Conversion done" );
+}
+
+my ( $conv_time , $conv_count ) = ( 0, 0 );
+sub generateTeX {
+    my $afpds = $self->{AFPDS} ;
+
+    # Check few things on RC
+    # At least a RC 001 or a RC 100 must have been provided
+    return &Error(_job_tag."No RC 001 or RC 100 defined")
+        unless (defined($self->{RC}->{'001'}) or defined($self->{RC}->{'100'}));
+    # If a RC 200 has been provided, we must also have a RC 201 and a RC 202
+    return &Error(_job_tag."Found wrong combination of record 200-202")
+        if (defined($self->{RC}->{'200'}) and
+        $self->{RC}->{'200'}->a2pxml_is_valid and
+        !(defined($self->{RC}->{'201'}) and defined($self->{RC}->{'202'})));
+
+    # Output the convertex TeX file
+    return &Error(_job_tag."Error while generating TeX file")
+        unless ($afpds->gentex( $TexFile ));
+
+    # Output to AfpFile and check TeX convertion rate
+    if (defined($afpbuffer) and length($afpbuffer)) {
+
+        # 1. Output to AfpFile
+        if (eof($AFPDSFILE)) {
+            print $AfpFile $afpbuffer if (defined($AfpFile));
+
+        } else {
+            # Output AfpFile without the last char '#'
+            print $AfpFile substr($afpbuffer,0,-1)
+                if (defined($AfpFile));
+
+            # And reset afpbuffer with only char '#' ( in ebcdic)
+            $afpbuffer = chr(0x7B);
+        }
+
+        # 2. Wait a little to match required TeX convertion rate
+        #    essentially on big job
+        if ( $MAX_CONV_RATE and $file > $MAX_CONV_RATE ) {
+            my $prev_conv_time = $conv_time ; # Default to zero
+
+            # Still sleep a little if we can
+            if ( $conv_time ) {
+                &MAXSTAT('CONV-RATE-PRE-SLEEP-TIME',$conv_time);
+                usleep $conv_time  ;
+            }
+
+            # Get the delay since the beginning of that conversion
+            $conv_time = &tv_interval($RateTimer) * 1_000_000 ;
+
+            # min_conv_time is the time by conversion to reach computed before
+            # each conversion start
+            my $diff = $conv_time - $file * $min_conv_time ;
+            my $count = $file > $conv_count ? $file - $conv_count : 1 ;
+            if ( $diff < 0 ) {
+                # Get the time we should have sleep to reach max_conv_rate
+                my $usleep = abs($diff) ;
+
+                # Really not sleep if time to sleep is too short
+                unless ( $usleep < $USLEEP ) {
+                    &UPSTAT('CONV-RATE-SLEEPING');
+                    &MAXSTAT('CONV-RATE-SLEEP-TIME',$usleep);
+                    &Debug("Waiting $usleep ms to lower speed as " .
+                        $MAX_CONV_RATE . " Max conversion rate was reached");
+                    usleep $usleep ;
+                }
+                $conv_time = $usleep / $count ;
+
+            } elsif ($prev_conv_time) {
+                &UPSTAT('CONV-RATE-SLEPT-TOO-MUCH');
+                # diff is the excess time we have slept
+                my $correction = $count > 0 ? $diff / $count : 0 ;
+
+                # Always reset $conv_time to keep the sleep next time
+                if ( $correction > 0 and $correction < $prev_conv_time
+                and $conv_time > $USLEEP ) {
+                    # Adjust conv_time to sleep less next time
+                    $conv_time = $prev_conv_time - $correction ;
+
+                } else {
+                    $conv_time = $prev_conv_time ;
+                }
+            }
+
+            # Remember conversion count
+            $conv_count = $file ;
+        }
+    }
+
+    # Return the job environment to JobManager
+    &Debug("File#" . $file . ": Shell env file generation");
+
+    # Set MTIME job env to file mtime
+    $afpds->updateEnv( { MTIME => $mtime } );
+
+    # Announce last job to master thread
+    $self->Return( $Job , $afpds->getEnv() );
+
+    # And keep some stats
+    $self->KeepStats( $Job, $afpds->getstat() );
+
+    # Update job state in spool
+    &a2pjobstate( $Job, 2, 'o' )
+        or &Info(_job_tag."Can't update status to step 2 done");
+
+    # Return true
+    1 ;
+}
+
+
+################################################################################
+sub End {
+    # End jobs here as it closes properly any opened file
+    my $ret  = shift || 0 ;
+    my $msg  = shift || "";
+
+    if (defined($msg)) {
+        $ret and $msg ? &Error($msg) : &Debug($msg) ;
+    }
+
+    # Now clean everything
+    &Debug("Closing files");
+
+    &CloseFiles();
+    close($AFPDSFILE) if (defined($AFPDSFILE));
+
+    return $ErrFlag ? $ErrFlag : $ret ;
+}
+
+our $AbortMessages = {
+    0   => "Unknown error",
+    1   => "Last TeX file not generated",
+    2   => "Can't generate TeX file",
+    3   => "Can't handle RC 5A without AFPDS flux defined",
+    4   => "Expected defined AFPDS flux here",
+    5   => "Can't processing standard AFP line without AFPDS Flux defined",
+    6   => "Can't load PAGEDEF as it isn't defined",
+    100 => "Can't use not defined '%s' controlrecord",
+    101 => "Found AFPDS text line with bad end of line <0x%04X>",
+    102 => "Unknown control record '%s'",
+    103 => "File#%s: Bad TeX file generation for print %s",
+    104 => "Unable to load PAGEDEF %s as Perl module %s not found",
+    105 => "freed error number",
+    106 => "Can't create %s folder: %s",
+    107 => "Can't open %s: %s",
+    108 => "Can't process %s in binary mode: %s",
+    109 => "Can't read last 10 chars of %s: %s",
+    110 => "Found AFPDS Field with bad end of line <0x%04X>",
+    111 => "Found AFPDS Field with bad length: %s vs %s",
+    112 => "Bad control record type format found for record type '%s'",
+    113 => "Bad control record length (%s) for record type '%s'",
+    114 => "Got bad AFPDS format as RC 5A is too short (%s < 8)",
+    115 => "Can't create RC object %d of type '%s' with TEXBASE '%s'",
+    116 => "Can't initialize RC type '%s' with buffer '%s'",
+    117 => "Can't use RC type '%s' on with no AFPDS Flux defined",
+    118 => "AFP error on RC 5A with ident %6X, flag %08b, reserved 0x%04X, ".
+           "long %d and buffer %s",
+    119 => "Can't use existing folder '%s' to compute AFPDS file",
+    120 => "Can't use RC type %d without previously defined RC type %d",
+    121 => "Can't save XML content for RC type %d in %s",
+    122 => "Folder '%s' not available",
+    123 => "Can't update '%s' attribut with value '%s' in A2P XML",
+    124 => "File '%s' is too short or corrupted",
+    200 => "Got RC 5A error %d, %s",
+    300 => "Got RC #%s# init error %d, %s",
+    500 => "trying to convert job %d after errors"
+};
+
+my @AbortErrors = (
+    0, 2, 3, 4, 5, 106, 107, 108, 109, 119, 122
+    );
+
+# Must be called with number identifying message and then abort processing
+sub Abort {
+    $ErrFlag = shift || 0 ;
+
+    unless ( defined($skip[$ErrFlag]) and $skip[$ErrFlag]++ ) {
+        @AbortTime = &gettimeofday();
+
+        my $file_offset = sprintf("AFPDS file off-set %Xh",tell($AFPDSFILE)) ;
+
+        my @ERR = $ErrFlag >= 500 ?
+            () : ( _job_tag . "Aborting at $file_offset" ) ;
+        my $msg = $ErrFlag >= 500 ? $file_offset.": " : "" ;
+        $msg .= _job_tag . $AbortMessages->{$ErrFlag} ;
+
+        my $ABTERM = $ErrFlag < 100 ?
+            $msg." (Err$ErrFlag)" : sprintf( $msg." (Err%d)" , @_, $ErrFlag ) ;
+
+        # Still return the ABTERM message to JobManager
+        $self->Return( $Job => &GetCom( comINF , 'ABTERM '.$ErrFlag, $ABTERM ));
+
+        push @ERR, $ABTERM ;
+        $ErrFlag < 500 ? &Error( @ERR ) : &Warn( @ERR );
+
+        # Return information to JobManager
+        map { $self->Return( $Job => &GetCom( comINF , 'ERROR' , $_ )) } @ERR ;
+
+        # Update status for afpjob
+        map { &a2pjobstate( $Job, 2, 'A', { ABTERM => "$_" } ) } @ERR ;
+
+        # Keep the ABTERM on the current JID if really started
+        if ( $file ) {
+            # Update status for subjob designed by JID key in %Infos
+            my $Infos = { JID => $Job . "-" . $file } ;
+            $Infos->{STATUS} = 'ABTERM' if ( $ErrFlag < 500 );
+            map {
+                $Infos->{ERRORS} = "$_" ;
+                &a2pjobstate( $Job, 2, 'A', $Infos );
+            } @ERR
+        }
+    }
+
+    if (grep { $_ == $ErrFlag } @AbortErrors) {
+        goto ABORTED_FILE ;
+
+    } else {
+        # Don't Abort file conversion to try next sub jobs
+        return $ErrFlag ;
+    }
+}
+
+END {
+    if ($ErrFlag and @AbortTime) {
+        my $time = sprintf("%.2f sec",&tv_interval(\@AbortTime));
+        &Error("Last conversion aborted $time ago with $ErrFlag abort number");
+    }
+}
+
+&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
+
+1;
Index: /A2P/a2p/a2p-stat.pl
===================================================================
--- /A2P/a2p/a2p-stat.pl	(revision 3)
+++ /A2P/a2p/a2p-stat.pl	(revision 3)
@@ -0,0 +1,869 @@
+#!/usr/bin/perl
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Simple service to synchronize Job STATISTICS with a DB
+#
+
+BEGIN {
+    use strict ;
+    use warnings ;
+    use POSIX 'setsid' ;
+    use A2P::Globals ;
+
+    our $VERSION = sprintf "%s", q$Rev: 415 $ =~ /(\d[0-9.]+)\s+/ ;
+
+    if (defined($ENV{JAVA_HOME}) and $ENV{JAVA_HOME}) {
+        # Don't fork if launch by Eclipse, script launcher unset JAVA_HOME
+        $Progname = "a2p-eclipse" ;
+        $MUSTQUIT = 1 ;
+
+    } else {
+        # Daemonize early
+        my $forkpid = 0 ;
+        our $argument = $ARGV[0] || "" ;
+        chdir '/'                      or die "Can't chdir to /: $!";
+        open *STDIN , '<', '/dev/null' or die "Can't read from /dev/null: $!";
+        open *STDOUT, '>', $StdoutFile or die "Can't write to $StdoutFile: $!";
+        defined($forkpid = fork)       or die "Can't fork: $!";
+
+        # Save son PID in system file provided as argument if file exists
+        if ( $forkpid > 0 ) {
+            if ( length($argument) > 0 ) {
+                open *PIDFILE , '>', $argument
+                    or die "Can't open PID file '$argument': $!";
+                print PIDFILE $forkpid ;
+                close(PIDFILE);
+            }
+            exit(0);
+        }
+    }
+}
+our $VERSION  ;
+our $argument ;
+our $Progname ;
+our $MUSTQUIT ;
+
+#--------------------------------------------------------------------------
+# Here we import any needed modules only after we are in background
+#--------------------------------------------------------------------------
+
+use strict   ;
+use warnings ;
+use Socket ;
+use IO::Socket ;
+use Fcntl ;
+use Fcntl qw(:flock);
+use GDBM_File ;
+use POSIX qw( :signal_h :sys_wait_h setsid );
+use Time::HiRes qw( usleep gettimeofday tv_interval );
+use A2P::Init   ;
+use A2P::Globals;
+use A2P::Syslog ;
+use A2P::Signal ;
+use A2P::Thread ;
+use A2P::Signal 'LogSigMessage' ;
+use A2P::DB ;
+use A2P::DB qw(
+    a2p_db_statistics_ready CheckJobsTables stats_set_service stats_jobmanager
+    stats_converter check_commit
+    );
+
+&Debug(" Module load error: $! $? $@") if ( $! or $? or $@ );
+&Debug(" =============================START==============================");
+
+&setsid                     or die "Can't set a new session: $!";
+open *STDERR, '>&', *STDOUT or die "Can't redirect STDERR to STDOUT: $!";
+
+#-------------------------------------
+# Here we are in a daemonized process
+#-------------------------------------
+
+&Debug("Current progname = $0, version $VERSION, started");
+&Debug("Setting service name to $Progname");
+# Update system name of this daemon to be pretty with ps command
+$0 = $Progname ;
+
+# Reset error code
+$! = 0 ;
+
+# Here constant
+my $dbmbase = "statistics.dbm" ;
+
+# First forked process is the master
+my $MASTER = 1 ;
+
+# Empty Sons/Threads lists and hashs, hash keys are processes PID
+# PID -> Managed folder
+my %sons = () ;
+my $LCK ;
+my $UNIXSOCK ;
+my %FILES = () ; # Hash to tie
+my $pid ;
+
+################################################################################
+### Only called from Main loop
+################################################################################
+sub CheckThreads {
+
+    my %known = () ;
+    map { $known{$_} = 0 } values(%sons) ;
+
+    while ( $MASTER and @_ ) {
+        $STATS_FOLDER = shift ;
+        next unless (defined($STATS_FOLDER) and $STATS_FOLDER);
+
+        # Skip still managed folder
+        if (defined($known{$STATS_FOLDER})) {
+            &Debug("Skipping still managed '$STATS_FOLDER' folder");
+
+        } else {
+            # Set some file name
+            my $unixname = $SERVICE_TMP . "/" . $dbmbase . '-' .$$. '_' .time ;
+            my $dbmname = $STATS_FOLDER . "/." . $dbmbase ;
+            my $lockname = $dbmname . ".LCK" ;
+
+            # First try to lock the lock file if exists
+            if ( -e $lockname ) {
+                &Debug("Checking why lock file still exists...");
+                if (open($LCK,$lockname)) {
+                    if (flock($LCK, LOCK_EX | LOCK_NB)) {
+                        flock($LCK, LOCK_UN);
+                        close($LCK);
+                        &Debug("Removing $lockname lock file on '$STATS_FOLDER'"
+                            . " as it is not used");
+                        unlink $lockname ;
+
+                    } else {
+                        &Debug("Still managed  by other thread " .
+                            " as I can't lock on '$lockname': $!");
+                    }
+
+                } else {
+                    &Error("Can't open lock file on '$STATS_FOLDER': $!");
+                }
+            }
+
+            if ( -e $lockname and -e $dbmname ) {
+                &Info("'$STATS_FOLDER' statistics manager seems still present");
+                $lockname = "" ;
+                my $tied = tie( %FILES,'GDBM_File',$dbmname,GDBM_READER,0666 );
+                if (defined($tied)) {
+                    $pid = $FILES{'PID'} ;
+                    my $sockname = $FILES{'SOCKET'} ;
+                    if (socket(SOCK, PF_UNIX, SOCK_STREAM, 0)) {
+                        if (-S $sockname
+                        and connect(SOCK, pack_sockaddr_un($sockname))) {
+                            $SIG{'ALRM'} = sub { close(SOCK) } ;
+                            alarm 5 ; # Get response until 5 seconds
+                            kill 12 , $pid ;
+                            my @messages = <SOCK> ;
+                            alarm 0 ;
+                            close(SOCK);
+                            my $last = pop @messages || "" ;
+                            &Debug("Got '$last' message on '$sockname'");
+                            $last =~ m|^<active\s+time=['](\d+)[']/>$| ;
+                            if (defined($1) and time - $1 < 60) {
+                                &Info("'$STATS_FOLDER' statistics manager " .
+                                    "still available as process $pid");
+                                $sons{$pid} = $STATS_FOLDER ;
+
+                            } else {
+                                &Info("'$STATS_FOLDER' statistics manager seems"
+                                    . " unavailable, trying to start another");
+                                $lockname = $dbmname . ".LCK" ;
+                            }
+
+                        } elsif (-S $sockname) {
+                            &Error("Can't connect to '$sockname' socket: $!");
+
+                        } else {
+                            &Info("'$STATS_FOLDER' statistics manager seems " .
+                                "not listening, trying to launch another one");
+                            $lockname = $dbmname . ".LCK" ;
+                        }
+
+                    } else {
+                        &Error("Can't create an unix socket: $!");
+                    }
+
+                } else {
+                    &Error("Can't open tied file $dbmname for reading: $!");
+                }
+
+                # Remove lock file if set again
+                unlink $lockname if $lockname ;
+            }
+
+            if ($lockname) {
+                &Info("Trying to start '$STATS_FOLDER' statistics manager");
+                if (open($LCK,">$lockname")) {
+                    if (flock($LCK, LOCK_EX | LOCK_NB)) {
+                        if (defined(tie ( %FILES, 'GDBM_File', $dbmname,
+                                          GDBM_WRCREAT, 0666 ))) {
+                            # Now we can fork as pre-init is done
+                            $pid = fork ;
+                            if (defined($pid)) {
+                                if ($pid) {
+                                    # In parent = master
+                                    $sons{$pid} = $STATS_FOLDER ;
+                                    untie %FILES ;
+                                    close($LCK);
+
+                                    &Debug("'$STATS_FOLDER' statistics manager"
+                                        . "forked");
+
+                                } else {
+                                    # In statistics manager
+                                    &InitStatistics($unixname);
+                                    &Info("'$STATS_FOLDER' statistics manager"
+                                        . " started");
+                                }
+
+                            } else {
+                                &Error("$STATS_FOLDER manager not forked: $!");
+                                untie %FILES ;
+                                flock($LCK, LOCK_UN);
+                                close($LCK);
+                            }
+
+                        } else {
+                            &Error("Can't open tied hash file '$dbmname': $!");
+                            flock($LCK, LOCK_UN);
+                            close($LCK);
+                        }
+
+                    } else {
+                        &Error("Can't lock folder '$STATS_FOLDER'" .
+                            "on '$lockname': $!");
+                        close($LCK);
+                    }
+
+                } else {
+                    &Error("Can't open '$lockname' lock file: $!");
+                }
+
+            } else {
+                &Info("Can't start '$STATS_FOLDER' statistics manager");
+            }
+        }
+
+        # Now we know this folder is managed
+        $known{$STATS_FOLDER} = 1 ;
+    }
+
+    if ($MASTER) {
+        # Check to stop no more needed threads
+        foreach my $folder ( grep { ! $known{$_} } keys(%known) ) {
+            &Info("Stopping synchronization of statistics from '$folder'");
+
+            ( $pid ) = grep { $sons{$_} eq $folder } keys(%sons) ;
+            next unless (defined($pid));
+            &Debug("Sending SIGTERM to T$pid");
+            kill 15 , $pid ;
+        }
+
+    } else {
+        # Free not used memory in son
+        undef %sons ;
+    }
+}
+
+sub InitCheck {
+
+    # Read conf
+    $do_init = 0 ;
+    &Init ;
+
+    # List statistics folders
+    my @STATS_FOLDERS = () ;
+    if ( $STATS_FOLDER =~ /:/ ) {
+        @STATS_FOLDERS = split(/:/,$STATS_FOLDER) ;
+
+    } else {
+        @STATS_FOLDERS = ( $STATS_FOLDER ) ;
+    }
+
+    # Check needed folders
+    my %Folders = (
+        SERVICE_TMP  =>  $SERVICE_TMP,
+        SHMDIR       =>  $SHMDIR
+        );
+
+    while ( my ($var, $Path) = each(%Folders) ) {
+        unless ( -d $Path ) {
+            &Info("Creating $Path folder as $var");
+            my $Folder = "" ;
+            foreach my $tmp_path ( split(m{[/]+}, $Path) ) {
+                $Folder .= "/$tmp_path" ;
+                mkdir $Folder , oct(775) unless ( -d $Folder );
+                &Error("Can't create '$Path' folder as $var: $!"), last
+                    unless ( -d $Folder );
+            }
+        }
+    }
+
+    # Initialize SERVICE_TMP folder
+    if ( -d $SERVICE_TMP ) {
+        unless ( system("touch $SERVICE_TMP/init_$Progname") == 0 ) {
+            &Error("Can't initialize $SERVICE_TMP folder: $!");
+            $MUSTQUIT = 1 ;
+        }
+
+    } else {
+        &Error("Can't initialize unavailable $SERVICE_TMP folder: $!");
+        $MUSTQUIT = 1 ;
+    }
+
+    # Test opening logfile in case of file logging
+    if ( $LOGFILENAME and ( $LOGFILE_VS_SYSLOG or $DEBUG_IN_FILE )) {
+        $! = 0 ;
+        unless (open(LOG,">$LOGFILENAME")) {
+            $LOGFILE_VS_SYSLOG = 0 ;
+            $DEBUG_IN_FILE     = 0 ;
+            return &Error("Can't open '$LOGFILENAME': $!");
+        }
+
+        if ( $LOGFILE_PURGE ) {
+            &UPSTAT('PURGE-LOG');
+            truncate LOG , 0 ;
+            $LOGFILE_PURGE = 0 ;
+        }
+
+        close(LOG);
+    }
+
+    # Reset Debug comportement
+    &ResetDebug() ;
+
+    &CheckThreads(@STATS_FOLDERS);
+
+    # @STATS_FOLDERS will be check in sons
+    return @STATS_FOLDERS ;
+}
+
+################################################################################
+### Only called from Forked loop
+################################################################################
+my %FH ;
+my %FH_TIMEOUT ;
+
+sub InitStatistics {
+    my $unixname = shift ;
+
+    $0 .= "-thread" ;
+    $MASTER = 0 ;
+    $SIG{'USR2'} = \&SigUSR2 ;
+
+    $FILES{'PID'} = $$ ;
+
+    if (&openUNIXSOCK($unixname)) {
+        $FILES{'SOCKET'} = $unixname ;
+
+    } else {
+        $FILES{'SOCKET'} = "" ;
+    }
+
+    # Synchronise %FILES with %FH
+    foreach my $file (keys(%FILES)) {
+        next if ($file =~ /^(SOCKET|PID)$/);
+        my $fullpathfile = "$STATS_FOLDER/$file" ;
+        if ( -e $fullpathfile and ! -d $fullpathfile ) {
+            $FH{$file} = 0 ;
+
+        } else {
+            delete $FILES{$file} ;
+            delete $FH_TIMEOUT{$file} ;
+        }
+    }
+}
+
+# Do some statistics load timing
+my @LastLoadCheck = &gettimeofday() ;
+my $LoadedLines = 0 ;
+my $activity = 0 ;
+
+sub statistics {
+    # List available files
+    my @files = <$STATS_FOLDER/*-Converter-????????> ;
+    push @files , <$STATS_FOLDER/*-JobManager-????????> ;
+
+    &TIMESTAT('FilesControl');
+    for my $file (@files) {
+        # Only keep files with Converter or JobManager
+        # and only a date at the end of the name
+        my @count =
+            $file =~ m*$STATS_FOLDER/([\w-]+)-(Converter|JobManager)-(\d{8})$* ;
+        unless ( ! -d $file and @count == 3 ) {
+            &Debug("Skipping '$file' read") if ($ADVANCED_DEBUGGING);
+            next ;
+        }
+
+        # Keep short filename only
+        $file = join('-',@count) ;
+
+        unless (defined($FH{$file})) {
+            my ($service,$type,$date) = @count ;
+            &Debug("Found new file to handle: $file for service " . $count[0] .
+                ", generated on " .$count[2]);
+            $FILES{$file} = $FH{$file} = 0 ;
+        }
+
+        # Check to return immediatly when requested
+        return 0 if ( $do_quit or $MUSTQUIT);
+    }
+    &TIMESTAT('FilesControl');
+
+    # Lines counter to load
+    my $line_nb = 0 ;
+
+    # Read files, get an array of new lines by file
+    my %newstats = () ;
+
+    &TIMESTAT('FilesRead');
+    foreach my $file (keys(%FH)) {
+        my $fh = $FH{$file} ;
+
+        # Don't read too much lines at a loop
+        my $maxlines = $MAX_LINES ;
+        my $stats_file = "$STATS_FOLDER/$file" ;
+
+        # 0. Check file is still present
+        unless ( $fh or -s $stats_file ) {
+            &Debug("'$file' was deleted");
+            close($fh) if $fh ;
+            delete $FH{$file} ;
+            delete $FILES{$file} ;
+            delete $FH_TIMEOUT{$file} ;
+            next ;
+        }
+
+        # 1. Check old file then open not opened files
+        if ($FILES{$file} == -s $stats_file) {
+            # Only check to delete a file if no new line are found and one day
+            # has past since file was closed or last checked
+            if (defined($FH_TIMEOUT{$file})
+            and &tv_interval($FH_TIMEOUT{$file})>86400) {
+
+                my $fileage = ( time - (stat($stats_file))[9] )/ 86400 ;
+
+                if ( $fileage > $STATSFILE_MAXAGE ) {
+                    &Info("Deleting old statistics file: $stats_file");
+                    unlink $stats_file
+                        or return &Error("Can't delete old statistics file: $!");
+
+                    close($FH{$file}) if $FH{$file} ;
+                    delete $FH{$file} ;
+                    delete $FILES{$file} ;
+                    delete $FH_TIMEOUT{$file} ;
+
+                } else {
+                    # Next check in one day
+                    $FH_TIMEOUT{$file} = [ &gettimeofday() ] ;
+                }
+            }
+
+            # Handles a timer on opened file to only keep few opened files
+            if ($FH{$file}) {
+                if (defined($FH_TIMEOUT{$file})) {
+                    # Close filehandle after 30 minutes if not used
+                    if (&tv_interval($FH_TIMEOUT{$file}) > 1800) {
+                        close($FH{$file}) ;
+                        $FH{$file} = 0 ;
+                        delete $FH_TIMEOUT{$file} ;
+                    }
+
+                } else {
+                    $FH_TIMEOUT{$file} = [ &gettimeofday() ] ;
+                }
+            }
+
+            # Anyway loop to another file
+            next ;
+
+        } elsif ( ! ( $fh = $FH{$file} )) {
+            undef $fh ; # Handle must be undefined when opening on it
+            return &Error("Can't open '$file' for reading: $!")
+                unless ( open $fh , $stats_file );
+            $FH{$file} = $fh ;
+            delete $FH_TIMEOUT{$file} ;
+        }
+
+        # 2. Seek to skip still handled lines
+        seek $fh, $FILES{$file}, 0
+            if ($fh and $FILES{$file} != tell($fh));
+
+        # 3. Read lines locking on the file to not read while it is written
+        unless (eof($fh)) {
+            my $locked = flock($fh, LOCK_EX);
+            next unless ($locked);
+            my $line = '' ;
+            while ( ! eof($fh) and $maxlines-- > 0 ) {
+                $line = readline($fh) ;
+                last unless (defined($line) and $line);
+                push @{$newstats{$file}} , $line ;
+                $line_nb ++ ;
+            }
+            flock($fh, LOCK_UN);
+
+            unless (@{$newstats{$file}}) {
+                &Debug("No new line found in '$file'");
+                delete $newstats{$file} ;
+            }
+
+            # Check to don't read too much line at a time
+            #last unless ($maxlines > 0 );
+        }
+
+        # Check to return immediatly when requested
+        return 0 if ( $do_quit or $MUSTQUIT);
+    }
+    &TIMESTAT('FilesRead');
+
+    if (keys(%newstats)) {
+        &Debug("Starting DB update");
+
+        # Be sure we are connected to DB
+        my $connected = &a2p_db_connected() ? 1 : &a2p_db_connect() ;
+        return &Error("Not connected to db") unless ($connected);
+
+        # Be sure DB is ready for statistics
+        &a2p_db_statistics_ready()
+            or return &Error("Db not ready for statistics");
+
+        # Reset activity meter
+        $activity = 0 ;
+
+    } else {
+        $activity ++ unless ($activity > 100);
+
+        # Still return if nothing to do
+        return $activity > 10 ? $activity : 10 ;
+    }
+
+    foreach my $stat (keys(%newstats)) {
+        my ( $service, $proc , $date ) =
+            $stat =~ /^(.*)-(JobManager|Converter)-(\d+)$/ ;
+        unless (defined($proc) and $proc and defined($date) and $date) {
+            &Error("Won't handle lines from unrecognized '$stat' file");
+            delete $newstats{$stat} ;
+            next ;
+        }
+
+        &stats_set_service($service);
+
+        scalar(@{$newstats{$stat}}) ;
+        &Debug("Have " . $line_nb . " lines to analyse in $stat")
+            if ( $line_nb > 100 );
+
+        foreach my $line (@{$newstats{$stat}}) {
+            chomp $line ;
+
+            # Skip headers lines
+            unless ( $line =~ /^(\d{8});(\d{6});/ ) {
+                $line_nb -- ;
+                next ;
+            }
+
+            my @Job = split(/;/,$line) ;
+            if ($proc eq 'JobManager' and scalar(@Job) > 8) {
+                &stats_jobmanager(\@Job)
+                    or return &Error("Can't manage '$line' JobManager " .
+                    "statistics line as (@Job) array from $stat file");
+
+            } elsif ($proc eq 'Converter' and scalar(@Job) > 12) {
+                &stats_converter(\@Job)
+                    or return &Error("Can't manage '$line' Converter " .
+                    "statistics line as (@Job) array from $stat file");
+
+            } else {
+                &Info("Can't handle '$line' as bad formatted '$proc' line " .
+                     "from $stat file");
+                next ;
+            }
+
+            # Check statistics loading rate each 30 seconds
+            $LoadedLines ++ ;
+            if (&tv_interval(\@LastLoadCheck) > 30) {
+                &Info(sprintf(
+                    "%d more lines loaded: Loading rate %.2f lines per second" .
+                    " (now on %s)",
+                    $LoadedLines, $LoadedLines/&tv_interval(\@LastLoadCheck),
+                    $stat))
+                    if ($LoadedLines>100);
+                @LastLoadCheck = &gettimeofday() ;
+                $LoadedLines = 0 ;
+            }
+
+            # Check to return immediatly when requested
+            return 0 if ( $do_quit or $MUSTQUIT);
+
+            # Check to commit after a delay, and also cache control
+            &check_commit();
+        }
+
+        # Update %FILES to current file position after DB has been updated
+        $FILES{$stat} = tell($FH{$stat}) ;
+    }
+
+    &Debug("DB update finished") ;
+
+    # Here every thing has been done
+    return 1 ;
+}
+
+sub openUNIXSOCK {
+    my $sockname = shift ;
+    &Debug("Creating '$sockname' unix socket");
+
+    # Open UNIX Socket
+    socket( $UNIXSOCK , PF_UNIX, SOCK_STREAM , 0 )
+        or return &Error("Can't create an unix socket: $!");
+
+    bless $UNIXSOCK , "IO::Socket" ;
+
+    unlink $sockname ;
+
+    bind( $UNIXSOCK , pack_sockaddr_un( $sockname ) )
+        or return &Error("Can't bind unix socket on '$sockname': $!");
+
+    listen( $UNIXSOCK , SOMAXCONN )
+        or return &Error("Can't listenn on unix socket '$sockname': $!");
+
+    &Debug("'$sockname' unix socket created");
+    1 ;
+}
+
+sub SigUSR2 {
+    if (defined($UNIXSOCK)) {
+        my $socket ;
+        $UNIXSOCK->blocking(0);
+        my $addr = accept($socket,$UNIXSOCK);
+        if ( $addr ) {
+            &Debug("Got connection on $socket socket");
+            bless $socket , "IO::Socket" ;
+            $socket->autoflush(1);
+            my $msg = "<active time='" . time . "'/>" ;
+            print $socket "$msg\n" ;
+            close($socket);
+            &Debug("Printed '$msg' on $socket socket");
+
+        } else {
+            &Warn("No client connection on SIGUSR2 received");
+        }
+
+    } else {
+        &Warn("Can't say I'm active");
+    }
+}
+
+
+################################################################################
+### Pre-init
+################################################################################
+
+&Info("$Progname service v" . A2P_RPM_VERSION . " starting");
+
+my @MarkTimer = &gettimeofday() ;
+$STATS{'A2PSTAT-VERSION'} = A2P_RPM_VERSION ;
+
+&InitCheck ; # This sub forks other managed statistics folders
+
+################################################################################
+### Main loop
+################################################################################
+
+my $started_check = $MASTER ? 10 : 0 ;
+my %restart = () ;
+my $factor = 0 ;
+
+&TIMESTAT('MainLoop');
+while ( ! $MUSTQUIT and (! $MASTER or keys(%sons))) {
+
+    if ($started_check) {
+        &Info("$Progname service v" . A2P_RPM_VERSION . " started")
+            unless (--$started_check);
+    }
+
+    &LogSigMessage();
+
+    if ($do_test) {
+        if ($MASTER) {
+            $STATS{'#### ID ####'} = "MASTER-$$" ;
+            kill 10, keys(%sons) ;
+        } else {
+            $STATS{'#### ID ####'} = "THREAD-$$ on $STATS_FOLDER" ;
+        }
+        A2P::Thread::self_TEST();
+    }
+
+    @MarkTimer = &gettimeofday() , &Info("---MARK---")
+        unless ( ! $MASTER or &tv_interval(\@MarkTimer) < 1800 );
+
+    ###########################
+    # Statistics handling code
+    ###########################
+    last unless ($MASTER or $factor = &statistics);
+
+    # Check also stopped thread in master
+    while ( $MASTER and $pid = waitpid(-1,&WNOHANG) ) {
+        last if ( $pid < 0 );
+        &Debug("Process $pid returned");
+
+        if (defined($sons{$pid})) {
+            my $folder = $sons{$pid} ;
+            if ($?>>8) {
+                &Warn("$folder statistics manager returned with code ".($?>>8));
+
+            } else {
+                &Info("$folder statistics manager returned");
+            }
+
+            my @folders = values(%sons) ;
+            delete $sons{$pid} ;
+
+            # Check if we need to restart the thread
+            unless ( $do_quit or $started_check ) {
+                &CheckThreads(@folders);
+                &Info("'$folder' statistics manager restarted");
+
+                my $now = time ;
+                if (defined($restart{$folder})) {
+                    # Reset restart statistics if older than a minute
+                    $restart{$folder} = [ 0 , $now ]
+                         if (time - $restart{$folder}->[1] > 60);
+
+                } else {
+                    $restart{$folder} = [ 0 , $now ] ;
+                }
+
+                $restart{$folder}->[0] ++ ;
+                my $last = $now - $restart{$folder}->[1] ;
+                if ( $last and $restart{$folder}->[0]/$last > 2 ) {
+                    &Debug(sprintf("Restart rate = %.2f" ,
+                        $restart{$folder}->[0]/$last));
+                    &Alert("Can't manage '$folder' statistics folder: " .
+                        "Too much restart");
+                    $do_quit ++ ;
+                }
+            }
+
+        } else {
+            &Warn("Unknown process $pid returned");
+        }
+    }
+
+    #######################
+    # Check flags
+    #######################
+
+    # true after QUIT/TERM signal has been received
+    last if ( $do_quit );
+
+    # true after HUP signal has been received
+
+    if ( $do_init ) {
+        my $temp = $STATS_FOLDER ; # Will re-check and keep STATS_FOLDER in sons
+        # Still quit if our STATS_FOLDER not in the current
+        last unless (grep { /^$temp$/ } &InitCheck());
+        if ($MASTER) {
+            map {
+                &Debug("Sending HUP signal to $_ thread");
+                kill 1, $_ ;
+            } keys(%sons) ;
+            &Info("Configuration reloaded");
+
+        } else {
+            $STATS_FOLDER = $temp ;
+        }
+    }
+
+    # Check to do last commits
+    &check_commit($factor);
+
+    $factor = 1 unless ($factor);
+
+    &TIMESTAT('MainLoop');
+    usleep $factor * $USLEEP ;
+    &TIMESTAT('MainLoop');
+}
+
+# We can safely activate debugging when quitting is requested
+$NO_SYSLOG_DEBUG = 0 if $SERVICE_DEBUG ;
+
+&LogSigMessage ;
+
+if ( $MASTER ) {
+    &Info("$Progname service is stopping");
+    &CheckThreads(); # This will kill sons with SIGTERM
+
+} else {
+    # Remove unix socket
+    close($UNIXSOCK);
+    unlink $FILES{'SOCKET'} ;
+
+    &a2p_db_disconnect();
+
+    # Free DBM file and statistics folder
+    untie %FILES ;
+    flock($LCK, LOCK_UN);
+    close($LCK);
+}
+
+# Wait until every child has quit
+while ( $pid = wait ) {
+    last if ( $pid < 0 );
+    &Debug("T$pid has terminated");
+}
+
+&LogSigMessage ;
+
+if ($MASTER) {
+    if (defined($argument)) {
+        &Debug("PID file = '$argument'");
+        # Delete our PID in PID file
+        if (open RET , ">$argument") {
+            print RET "0" ;
+            close(RET);
+
+        } else {
+            &Error("Can't open PID file '$argument': $!");
+        }
+    }
+
+    &Info("$Progname service stopped");
+
+} else {
+    &Info("Synchronization of statistics from '$STATS_FOLDER' stopped");
+}
+
+exit(0);
+
+END {
+    # Output statistics when quitting from a disgnostic service
+    A2P::Thread::self_TEST() if ($Progname =~ /^diagnostics/);
+
+    $MASTER ?
+    &Debug("=============================QUIT===============================")
+    :
+    &Debug($0 . "[$$] =====QUIT=====");
+    &LogSigMessage ;
+}
Index: /A2P/a2p/a2p-stat.sh
===================================================================
--- /A2P/a2p/a2p-stat.sh	(revision 3)
+++ /A2P/a2p/a2p-stat.sh	(revision 3)
@@ -0,0 +1,285 @@
+#!/bin/sh
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# a2p-stat: This is the init script for starting up a2p-stat.pl
+#
+# chkconfig: 345 99 10
+# description: Starts and stops a2p-stat daemon
+#              that handles job statistics
+# processname: a2p-stat
+# pidfile: /var/run/a2p-stat.pid
+
+# Source function library.
+. /etc/init.d/functions
+
+# See how we were called.
+
+# Strip service name from Sxx/Kxx if started during boot or during shutdown
+prog="`basename $0|sed -re 's/^S[0-9]{2}//' -e 's/^K[0-9]{2}//'`"
+pid="`pidof $prog`"
+
+# Delete PID file if service is not running
+[ -z "$pid" -a -s /var/run/$prog.pid ] && rm -f /var/run/$prog.pid
+
+# Optional conf integration
+if [ -n "$prog" -a -e "/etc/afp2print/${prog}.conf" ]; then
+    . "/etc/afp2print/${prog}.conf"
+fi
+
+[ -z "$LOCKID" ] && LOCKID="`hostname -s|tr 'a-z' 'A-Z'`"
+export LOCKID
+
+# Perl library path options to help service to found its needed modules
+PERLOPT=""
+[ -d "$AFP2PRINT_PATH/A2P" ] && PERLOPT="$PERLOPT -I$AFP2PRINT_PATH"
+
+# Prepare Perl binary environment
+# Also unset JAVA_HOME in case it is in our ENV as it should exist only during
+# launch by Eclipse IDE, we need a LOCKID to ask process to load its conf
+PERLENV="unset JAVA_HOME ; LANG=C LOCKID=\"$LOCKID\""
+
+# These defaults can be overided in confs
+: ${AFP2PRINT_USER:=afp2print}
+: ${SERVICE_PROG:=$AFP2PRINT_PATH/a2p-stat.pl}
+: ${SERVICE_DEBUG:=0}
+: ${PERL:=/usr/bin/perl}
+: ${NICE:=nice -19}
+: ${LOGFILENAME:=/var/log/a2p.debug}
+
+start() {
+    # For SELinux we need to use 'runuser' not 'su'
+    SU=su
+    if [ -s /etc/redhat-release ]; then
+        if ! fgrep -q "Red Hat Enterprise Linux ES release 3" /etc/redhat-release; then
+            [ -x /sbin/runuser ] && SU=runuser
+        fi
+    fi
+
+    echo -n "Starting $prog: "
+    if [ -e /var/lock/subsys/$prog ]; then
+        if [ -s /var/run/$prog.pid ] && [ -e /proc/`< /var/run/$prog.pid` ]; then
+            echo -n "cannot start $prog: $prog is already running.";
+            failure "cannot start $prog: $prog already running.";
+            echo
+            return 1
+        fi
+    fi
+
+    # Prepare pid file
+    touch /var/run/${prog}.pid
+    chown $AFP2PRINT_USER /var/run/${prog}.pid
+    chmod 664 /var/run/${prog}.pid
+
+    # Check user will be able to output in LOGFILENAME
+    if (( DEBUG_IN_FILE > 0 || LOGFILE_VS_SYSLOG > 0 )); then
+        touch $LOGFILENAME
+        chown $AFP2PRINT_USER $LOGFILENAME
+        chmod 664 $LOGFILENAME
+    fi
+
+    # Touch the service debug file in case we need to keep some information
+    # Usefull when debugging Perl compilation problems
+    if (( SERVICE_DEBUG > 0 )); then
+        touch /var/run/${prog}.debug
+        chown $AFP2PRINT_USER /var/run/${prog}.debug
+        if [ "$1" == "debug" ]; then
+            PERLOPT="$PERLOPT -dt"
+            echo -n "" >/var/run/${prog}.trace
+            chown $AFP2PRINT_USER /var/run/${prog}.trace
+            chmod 664 /var/run/${prog}.trace
+            PERLENV="$PERLENV PERLDB_OPTS=\"NonStop=1 LineInfo=/var/run/${prog}.trace frame=4 dieLevel=2\""
+        fi
+    else
+        rm -f /var/run/$prog.debug
+    fi
+
+    # Start service
+    $NICE $SU - $AFP2PRINT_USER -c "$PERLENV $PERL $PERLOPT $SERVICE_PROG /var/run/$prog.pid"
+    RETVAL=$?
+    [ $RETVAL -eq 0 ] && touch /var/lock/subsys/$prog && success $prog;
+    echo
+    while [ ! -s /var/run/$prog.pid -a $RETVAL -eq 0 ]
+    do
+        usleep 100000
+    done
+    if [ -n "$1" -a -x "/usr/bin/$1" -a -s /var/run/$prog.pid ]; then
+        pid=`</var/run/$prog.pid`
+        if [ "$1" == "strace" ]; then
+            strace -T -a 120 -s 64 -tt -p $pid -f -q -o /var/log/a2p.strace&
+        elif [ "$1" == "ltrace" ]; then
+            ltrace -C -f -T -s 64 -tt -p $pid -o /var/log/a2p.ltrace&
+        fi
+    fi
+    return $RETVAL
+}
+
+stop() {
+    echo -n "Stopping $prog: "
+    if [ ! -e /var/lock/subsys/$prog ]; then
+        echo -n "cannot stop $prog: $prog is not running."
+        failure "cannot stop $prog: $prog is not running."
+        echo
+        return 1;
+    fi
+
+    let RETVAL=0 TOTALRETVAL=0
+    pid="`pidof $prog`"
+
+    for p in $pid
+    do
+        # Send signal to process group
+        kill -TERM $p
+        RETVAL=$?
+        let TOTALRETVAL+=RETVAL
+    done
+
+    [ $TOTALRETVAL -eq 0 ] && rm -f /var/lock/subsys/$prog && echo_success;
+    # Wait max 3 minutes for the service to update its pid to 0 when really quitting
+    let TIMEOUT=10
+    while [ -s /var/run/$prog.pid -a $RETVAL -eq 0 ]
+    do
+        [ "`< /var/run/$prog.pid`" == "0" ] && break
+        usleep 100000
+        (( --TIMEOUT == 0 )) && break
+    done
+    [ -s /var/run/$prog.pid ] && [ "`< /var/run/$prog.pid`" -gt 0 -a $RETVAL -eq 0 ] && RETVAL=1
+    echo
+    return $RETVAL
+}
+
+abort() {
+    pid="`pidof $prog`"
+    echo -n "Aborting any $prog process: $pid"
+
+    for p in $pid
+    do
+        # Send signal to process group
+        kill -ABRT -$p
+    done
+
+    rm -f /var/lock/subsys/$prog
+    echo_success
+    echo
+    return 0
+}
+
+a2pkill() {
+    pid="`pidof $prog`"
+    echo -n "Killing any $prog process: $pid"
+
+    for p in $pid
+    do
+        # Send signal to process group
+        kill -KILL -$p
+    done
+
+    rm -f /var/lock/subsys/$prog
+    echo_success
+    echo
+    return 0
+}
+
+check() {
+    pid="`pidof $prog`"
+    echo -n "Debugging any $prog process: $pid"
+
+    for p in $pid
+    do
+        # Send signal to process group
+        kill -USR1 -$p
+    done
+
+    sleep 1
+
+    echo_success
+    echo
+
+    cat   /tmp/$prog*-self$1.log
+    rm -f /tmp/$prog*-self*.log
+
+    return 0
+}
+
+rhstatus() {
+    status $prog
+}
+
+restart() {
+      stop
+      sleep 1
+    start
+}
+
+reload() {
+    echo -n "Reloading $prog daemon configuration: "
+    killproc $prog -HUP
+    RETVAL=$?
+    echo
+    return $RETVAL
+}
+
+case "$1" in
+  start)
+      start $2
+    ;;
+  stop)
+      stop
+    ;;
+  abort)
+      abort
+    ;;
+  kill)
+      a2pkill
+    ;;
+  restart)
+      restart
+    ;;
+  reload)
+      reload
+    ;;
+  status)
+      rhstatus
+    ;;
+  test)
+      check "test"
+    ;;
+  debug)
+      check "debug"
+    ;;
+  check)
+      check $1
+    ;;
+  condrestart)
+      [ -f /var/lock/subsys/$prog ] && restart || :
+    ;;
+  *)
+    echo "Usage: ${prog} {start|stop|abort|kill|status|reload|restart|condrestart|test|debug}"
+    exit 1
+esac
+
+# Check debug output
+OUTPUT="/var/run/${prog}.debug"
+if [ -s "$OUTPUT" ]; then
+    echo "Debug output for $prog service:"
+    egrep -v '^(.*/usr/share/mysql/charsets|Character set)' "$OUTPUT"
+    [ "$1" == "stop" -o "$1" == "abort" -o "$1" == "kill" ] && rm -f "$OUTPUT"
+fi
Index: /A2P/a2p/a2p-status.pl
===================================================================
--- /A2P/a2p/a2p-status.pl	(revision 3)
+++ /A2P/a2p/a2p-status.pl	(revision 3)
@@ -0,0 +1,424 @@
+#!/usr/bin/perl
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Simple service to synchronize Job STATUS with a DB
+#
+
+BEGIN {
+    use strict ;
+    use warnings ;
+    use POSIX 'setsid' ;
+    use A2P::Globals ;
+
+    our $VERSION = sprintf "%s", q$Rev: 1185 $ =~ /(\d[0-9.]+)\s+/ ;
+
+    if (defined($ENV{JAVA_HOME}) and $ENV{JAVA_HOME}) {
+        # Don't fork if launch by Eclipse, script launcher unset JAVA_HOME
+        $Progname = "a2p-eclipse" ;
+        $MUSTQUIT = 1 ;
+
+    } else {
+        # Daemonize early
+        my $forkpid = 0 ;
+        our $argument = $ARGV[0] || "" ;
+        chdir '/'                      or die "Can't chdir to /: $!";
+        open *STDIN , '<', '/dev/null' or die "Can't read from /dev/null: $!";
+        open *STDOUT, '>', $StdoutFile or die "Can't write to $StdoutFile: $!";
+           defined($forkpid = fork)       or die "Can't fork: $!";
+
+        # Eventually save son PID in system file provided as argument and exit
+        if ( $forkpid > 0 ) {
+            if ( length($argument) > 0 ) {
+                open *PID, '>', $argument
+                    or die "Can't open PID file '$argument': $!";
+                print PID $forkpid ;
+                close(PID);
+            }
+            exit(0);
+        }
+    }
+}
+our $VERSION  ;
+our $argument ;
+our $Progname ;
+our $MUSTQUIT ;
+
+#-------------------------------------------------------------------------------
+# Here we import any needed modules only after we are in background
+#-------------------------------------------------------------------------------
+
+use strict   ;
+use warnings ;
+use integer  ;
+use POSIX qw( :signal_h :sys_wait_h setsid );
+use Time::HiRes qw( usleep gettimeofday tv_interval );
+use A2P::Init   ;
+use A2P::Globals;
+use A2P::Syslog ;
+use A2P::Signal ;
+use A2P::Thread ;
+use A2P::JobStatus qw( sync_dbm_to_db get_status );
+use A2P::Signal 'LogSigMessage' ;
+use A2P::DB ;
+use A2P::DB qw( CheckJobsStatusTables CheckJobsQueueTable get_serviceid_info );
+use A2P::Infos ;
+use A2P::AfpJob ;
+
+&Debug(" Module load error: $! $? $@") if ( $! or $? or $@ );
+&Debug(" =============================START==============================");
+
+&setsid                     or die "Can't set a new session: $!";
+open *STDERR, '>&', *STDOUT or die "Can't redirect STDERR to STDOUT: $!";
+
+#-------------------------------------
+# Here we are in a daemonized process
+#-------------------------------------
+
+&Debug("Current progname = $0, version $VERSION, started");
+&Debug("Setting service name to $Progname");
+# Update system name of this daemon to be pretty with ps command
+$0 = $Progname ;
+
+# Reset error code
+$! = 0 ;
+
+################################################################################
+sub InitCheck {
+
+    # Read conf
+    &Init ;
+
+    # Check needed folders
+    my %Folders = (
+        SERVICE_TMP  =>  $SERVICE_TMP,
+        SHMDIR       =>  $SHMDIR
+        );
+
+    while ( my ($var, $Path) = each(%Folders) ) {
+        unless ( -d $Path ) {
+            &Info("Creating $Path folder as $var");
+            my $Folder = "" ;
+            foreach my $tmp_path ( split(m{[/]+}, $Path) ) {
+                $Folder .= "/$tmp_path" ;
+                mkdir $Folder , oct(775) unless ( -d $Folder );
+                &Error("Can't create '$Path' folder as $var: $!"), last
+                    unless ( -d $Folder );
+            }
+        }
+    }
+
+    # Initialize SERVICE_TMP folder
+    if ( -d $SERVICE_TMP ) {
+        unless ( system("touch $SERVICE_TMP/init_$Progname") == 0 ) {
+            &Error("Can't initialize $SERVICE_TMP folder: $!");
+            $MUSTQUIT = 1 ;
+        }
+
+    } else {
+        &Error("Can't initialize unavailable $SERVICE_TMP folder: $!");
+        $MUSTQUIT = 1 ;
+    }
+
+    # Test opening logfile in case of file logging
+    if ( $LOGFILENAME and ( $LOGFILE_VS_SYSLOG or $DEBUG_IN_FILE )) {
+        $! = 0 ;
+        unless (open(*LOG, '>', $LOGFILENAME)) {
+            $LOGFILE_VS_SYSLOG = 0 ;
+            $DEBUG_IN_FILE     = 0 ;
+            return &Error("Can't open '$LOGFILENAME': $!");
+        }
+
+        if ( $LOGFILE_PURGE ) {
+            &UPSTAT('PURGE-LOG');
+            truncate LOG , 0 ;
+            $LOGFILE_PURGE = 0 ;
+        }
+
+        close(LOG);
+    }
+
+    # Reset Debug comportement
+    &ResetDebug() ;
+
+    &Info("Configuration reloaded") if ($do_init);
+    $do_init = 0 ;
+}
+
+################################################################################
+
+&InitCheck( $do_init = 0 );
+
+################################################################################
+### Local variables
+################################################################################
+my @MarkTimer = &gettimeofday() ;
+
+# Status objects hash ref
+my $STATUS = {} ;
+my $factor = 0 ;
+my $mode   = 0 ;
+my $afpjob = undef ;
+my $try_connect = 1 ;
+my $connected = 0 ;
+my $not_connected_timer = undef ;
+my $delay = 60 ;
+my %lockid_list = () ;
+my $event_timer = undef ;
+
+# Initialization from DB
+my $services_infos ;
+$services_infos = &get_serviceid_info()
+    if (&a2p_db_connect() and &CheckJobsStatusTables());
+
+&Info("$Progname service v" . A2P_RPM_VERSION . " started");
+$STATS{'A2P-STATUS-VERSION'} = A2P_RPM_VERSION ;
+
+# Main loop
+while ( ! $MUSTQUIT ) {
+    &TIMESTAT('MainLoop');
+
+    &LogSigMessage();
+
+    A2P::Thread::self_TEST() if $do_test ;
+
+    @MarkTimer = &gettimeofday() , &Info("---MARK---")
+        unless ( &tv_interval(\@MarkTimer) < 1800 );
+
+    ##################################################################
+    # 1. Get a DB Access and check db tables
+    ##################################################################
+    $connected = 1
+        if (( ! $connected or $try_connect-- > 0 ) and &a2p_db_connect());
+
+    if ( $connected > 0 and &CheckJobsStatusTables and &CheckJobsQueueTable ) {
+        #############################
+        # 2. Read all status objects
+        #############################
+        &sync_dbm_to_db ;
+
+        ###########################################################
+        # 3. Check for events in jobs_queue table for current mode
+        ###########################################################
+        my @list = keys(%lockid_list) ;
+        if ( defined($services_infos) and @list ) {
+            my $count = 5 ;
+            my $lockid = shift @list ;
+            while ( $count-- ) {
+                my ( $serviceid, $name ) = @{$lockid_list{$lockid}} ;
+                #&Debug("Getting events for $name service")
+                #    if ($ADVANCED_DEBUGGING) ;
+
+                if (defined($afpjob) and $afpjob) {
+                    $afpjob = $afpjob->get_next_from_db($serviceid) ;
+                    if (ref($afpjob) =~ /^A2P::AfpJob/) {
+                        my $job = $afpjob->jobname ;
+                        # Got an event
+                        &UPSTAT('A2P-STATUS-GOT-EVENT-'.$lockid);
+                        &Debug("Got event for $name service on $job")
+                            if ($ADVANCED_DEBUGGING) ;
+
+                        # Update the Status from our memory
+                        my $status = &get_status($job);
+                        $afpjob->set_status_object($status) if ($status);
+
+                        # Update afpspool/service name
+                        my @service = ( $lockid, $name ) ;
+                        my $spool = $services_infos->get_afpspool_of(@service);
+                        my @spools = $services_infos->get_spools_of(@service) ;
+                        &Debug("Setting afpspool to $spool on $job")
+                            if ($ADVANCED_DEBUGGING) ;
+                        $afpjob->afpspool($spool);
+                        $afpjob->otherspools(@spools);
+                        $afpjob->service($name);
+
+                        # Handle event getting if deleting (chained events case)
+                        my $neg_is_deleted = $afpjob->handle_event
+                            or &Warn("Bad event handling on " . $job .
+                                " A2P::AfpJob object");
+
+                        # Synchronize us in jobs_queue table unless deleted
+                        &Warn("Bad event synchro on $job A2P::AfpJob")
+                            unless ( $neg_is_deleted < 0
+                            or $afpjob->sync_with_jobs_queue );
+
+                    } else {
+                        # Select next mode and/or next lockid to check
+                        if ($mode) {
+                            &UPSTAT('A2P-STATUS-ADV-EVENT-CHECKED-'.$lockid);
+                            $mode = 0 ;
+                            delete $lockid_list{$lockid} ;
+                            last unless @list ; # All possible event checked
+                            $lockid = shift @list ;
+
+                        } else {
+                            &UPSTAT('A2P-STATUS-USER-EVENT-CHECKED-'.$lockid);
+                            $mode = 1 ;
+                        }
+
+                        $afpjob = new A2P::AfpJob($mode) ;
+                        &Debug("Getting events for $name service with mode " .
+                            $mode ) if ($ADVANCED_DEBUGGING) ;
+
+                        $count ++ ;
+                        next ;
+                    }
+
+                } else {
+                    # Initialize with a fake afpjob
+                    $afpjob = new A2P::AfpJob($mode) ;
+                    $count ++ ;
+                    next ;
+                }
+           }
+
+        } elsif ( ref($services_infos) !~ /^A2P::Infos/i
+        and ( ! defined($event_timer) or &tv_interval($event_timer) > 2 )) {
+            # Reset event check timer
+            $event_timer = [ &gettimeofday() ];
+
+            $services_infos = &get_serviceid_info ;
+
+        } elsif ( ! defined($event_timer) or &tv_interval($event_timer) > 2 ) {
+            # Reset lockid list to check for events
+            foreach my $lockid ($services_infos->get_lockid_list()) {
+                my $sname = $services_infos->get_servicename_of($lockid) || '' ;
+                next unless $sname ;
+                $lockid_list{$lockid} = [
+                    $services_infos->get_serviceid_of($lockid), $sname ];
+            }
+
+            # Control list
+            @list = keys(%lockid_list) ;
+            &Debug("Checking events for services: " .
+                join( ', ', map { "$_ (@{$lockid_list{$_}})" } @list ))
+                if ($ADVANCED_DEBUGGING);
+
+            # Reset event check timer
+            $event_timer = [ &gettimeofday() ];
+        }
+
+        # TODO Check SHMDIR for not finished work
+
+        # Check if still connected to DB, this reconnect also to DB if a DB
+        # error is detected or if a reconnection DB timer is set
+        unless (&a2p_db_connected) {
+            &Info("Just disconnected from DB", "Retrying DB connection");
+            $connected = 0 ;
+        }
+
+    } elsif ( $connected > 0 ) {
+        # Log any pending warning from DBI API
+        &LogSigMessage();
+        # Not a connection error but a checktable error just warn and retry
+        # connection in 10 minutes
+        &Warn("Disconnecting from DB for 10 minutes");
+        &a2p_db_disconnect ;
+        $not_connected_timer = [ &gettimeofday() ];
+        $connected = $try_connect = -10 ;
+
+    } elsif ( ! $connected ) {
+        &Info("Disconnected from DB");
+        $not_connected_timer = [ &gettimeofday() ];
+        $connected-- ;
+        # Anyway reset delay to one minute
+        $delay = 60 ;
+
+    } elsif ( $connected <= 10 ) {
+        # Retry only after 10 min when more than 10 connections have failed
+        $delay = 600 ;
+    }
+
+    # Check disconnection timing when not connected
+    if ( $connected < 0 and &tv_interval($not_connected_timer) >= $delay ) {
+        my $delta = abs($connected) ;
+        $delta += 9 * ($connected - 10) if ( $delta >= 10 );
+        &Info("Retrying DB connection after $delta minutes disconnection");
+        $try_connect = 1 ;
+        $not_connected_timer = [ &gettimeofday() ];
+        $connected-- ;
+    }
+
+    #######################
+    # Check flags
+    #######################
+
+    # true after QUIT/TERM signal has been received
+    &TIMESTAT('MainLoop'), last if ( $do_quit );
+
+    # true after HUP signal has been received
+    &InitCheck() if ( $do_init );
+
+    # Check to do last commits
+    &check_commit() if ( $connected > 0 );
+
+    # Adapt USLEEP factor to be 1 when JobStatus has been found
+    # and grow up to 10 otherwise
+    if (keys(%{$STATUS})) {
+        $factor = 1 ;
+
+    } elsif ( $factor < 10 ) {
+        $factor ++ ;
+    }
+
+    # Avoid zombies sub-processes
+    waitpid(-1,&WNOHANG);
+
+    &TIMESTAT('MainLoop');
+    usleep $factor * $USLEEP ;
+    &UPSTAT('SLEEP-IN-MAINLOOP');
+}
+
+# We can safely activate debugging when quitting is requested
+$NO_SYSLOG_DEBUG = 0 if $SERVICE_DEBUG ;
+
+&a2p_db_disconnect();
+&LogSigMessage ;
+
+&Info("$Progname service is stopping");
+
+# Wait until every child has quit
+while ( my $pid = wait ) {
+    last if ( $pid < 0 );
+    &Debug("T$pid has terminated");
+}
+
+&Debug("PID file = '$argument'");
+
+if (defined($argument)) {
+    # Delete our PID in PID file
+    open *RET , '>', $argument or die "Can't open PID file '$argument': $!";
+    print RET "0" ;
+    close(RET);
+}
+
+&LogSigMessage ;
+&Info("$Progname service stopped");
+
+exit(0);
+
+END {
+    # Output statistics when quitting from a diagnostic service
+    A2P::Thread::self_TEST() if ($Progname =~ /^diagnostics/);
+
+    &Debug("=============================QUIT===============================");
+    &LogSigMessage ;
+}
Index: /A2P/a2p/a2p-status.sh
===================================================================
--- /A2P/a2p/a2p-status.sh	(revision 3)
+++ /A2P/a2p/a2p-status.sh	(revision 3)
@@ -0,0 +1,324 @@
+#!/bin/sh
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# a2p-db: This is the init script for starting up a2p-status.pl
+#
+# chkconfig: 345 99 10
+# description: Starts and stops a2p-status daemon
+#              that handles job status
+# processname: a2p-status
+# pidfile: /var/run/a2p-status.pid
+
+# Source function library.
+. /etc/init.d/functions
+
+# See how we were called.
+
+# Strip service name from Sxx/Kxx if started during boot or during shutdown
+prog="`basename $0|sed -re 's/^S[0-9]{2}//' -e 's/^K[0-9]{2}//'`"
+pid="`pidof $prog`"
+pidfile="/var/run/$prog.pid"
+
+# Delete PID file if service is not running
+if [ -z "$pid" -a -s "$pidfile" ]; then
+    echo "$prog service is dead"
+    rm -f "$pidfile"
+fi
+
+# Optional conf integration
+if [ -n "$prog" -a -e "/etc/afp2print/${prog}.conf" ]; then
+    . "/etc/afp2print/${prog}.conf"
+fi
+
+[ -z "$LOCKID" ] && LOCKID="`hostname -s|tr 'a-z' 'A-Z'`"
+export LOCKID
+
+# Perl library path options to help service to found its needed modules
+PERLOPT=""
+[ -d "$AFP2PRINT_PATH/A2P" ] && PERLOPT="$PERLOPT -I$AFP2PRINT_PATH"
+
+# Prepare Perl binary environment
+# Also unset JAVA_HOME in case it is in our ENV as it should exist only during
+# launch by Eclipse IDE, we need a LOCKID to ask process to load its conf
+PERLENV="unset JAVA_HOME ; LANG=C LOCKID=\"$LOCKID\""
+
+# These defaults can be overided in confs
+: ${AFP2PRINT_USER:=afp2print}
+: ${SERVICE_PROG:=$AFP2PRINT_PATH/a2p-status.pl}
+: ${SERVICE_DEBUG:=0}
+: ${PERL:=/usr/bin/perl}
+: ${NICE:=nice -19}
+: ${LOGFILENAME:=/var/log/a2p.debug}
+
+start() {
+    # For SELinux we need to use 'runuser' not 'su'
+    SU=su
+    if [ -s /etc/redhat-release ]; then
+        if ! fgrep -q "Red Hat Enterprise Linux ES release 3" /etc/redhat-release; then
+            [ -x /sbin/runuser ] && SU=runuser
+        fi
+    fi
+
+    echo -n "Starting $prog: "
+    if [ -e "/var/lock/subsys/$prog" ]; then
+        if [ -s "$pidfile" ] && [ -e /proc/`< "$pidfile"` ]; then
+            failure $prog
+            echo
+            echo "Cannot start $prog: $prog is already running."
+            return 1
+        fi
+    fi
+
+    # Prepare pid file
+    touch "$pidfile"
+    chown $AFP2PRINT_USER "$pidfile"
+    chmod 664 "$pidfile"
+
+    # Check user will be able to output in LOGFILENAME
+    if (( DEBUG_IN_FILE > 0 || LOGFILE_VS_SYSLOG > 0 )); then
+        touch $LOGFILENAME
+        chown $AFP2PRINT_USER $LOGFILENAME
+        chmod 664 $LOGFILENAME
+    fi
+
+    # Touch the service debug file in case we need to keep some information
+    # Usefull when debugging Perl compilation problems
+    if (( SERVICE_DEBUG > 0 )); then
+        touch /var/run/${prog}.debug
+        chown $AFP2PRINT_USER /var/run/${prog}.debug
+        if [ "$1" == "debug" ]; then
+            PERLOPT="$PERLOPT -dt"
+            echo -n "" >/var/run/${prog}.trace
+            chown $AFP2PRINT_USER /var/run/${prog}.trace
+            chmod 664 /var/run/${prog}.trace
+            PERLENV="$PERLENV PERLDB_OPTS=\"NonStop=1 LineInfo=/var/run/${prog}.trace frame=4 dieLevel=2\""
+        fi
+    else
+        rm -f /var/run/$prog.debug
+    fi
+
+    # Start service
+    $NICE $SU - $AFP2PRINT_USER -c "$PERLENV $PERL $PERLOPT $SERVICE_PROG /var/run/$prog.pid"
+
+    # Control started process
+    RETVAL=$?
+    if [ $RETVAL -eq 0 ]; then
+        touch /var/lock/subsys/$prog
+
+        # 3 minutes countdown
+        let COUNTDOWN=900
+        while [ ! -s "$pidfile" ]
+        do
+            usleep 100000
+            (( --COUNTDOWN < 1 )) && break
+        done
+
+        if [ -n "$1" -a -x "/usr/bin/$1" -a -s "$pidfile" ]; then
+            pid=`"$pidfile"`
+            if [ "$1" == "strace" ]; then
+                strace -T -a 120 -s 64 -tt -p $pid -f -q -o /var/log/a2p.strace&
+            elif [ "$1" == "ltrace" ]; then
+                ltrace -C -f -T -s 64 -tt -p $pid -o /var/log/a2p.ltrace&
+            fi
+        fi
+
+        # Success ?
+        [ -s "$pidfile" ] && success $prog || failure $prog
+        echo
+    fi
+    return $RETVAL
+}
+
+stop() {
+    echo -n "Stopping $prog: "
+    if [ ! -e "/var/lock/subsys/$prog" ]; then
+        failure $prog
+        echo
+        echo "Cannot stop $prog: $prog is not running."
+        return 1
+    fi
+
+    let RETVAL=0 TOTALRETVAL=0
+    pid="`pidof $prog`"
+
+    for p in $pid
+    do
+        # Send signal to process group
+        kill -TERM $p
+        RETVAL=$?
+        let TOTALRETVAL+=RETVAL
+    done
+
+    if [ $TOTALRETVAL -eq 0 ]; then
+        # Wait max 3 minutes for the service to update its pid to 0 when really quitting
+        let TIMEOUT=900
+        while [ -s "$pidfile" ]
+        do
+            [ "`< $pidfile`" -eq "0" ] && break
+            usleep 100000
+            (( --TIMEOUT < 1 )) && break
+        done
+        [ -s "$pidfile" ] && [ "`< $pidfile`" -gt 0 ] && RETVAL=1
+    fi
+
+    if [ $RETVAL -eq 0 ]; then
+        success $prog
+        rm -f "/var/lock/subsys/$prog" "$pidfile"
+    else
+        failure $prog
+    fi
+    echo
+    return $RETVAL
+}
+
+abort() {
+    pid="`pidof $prog`"
+    echo -n "Aborting any $prog process: $pid"
+
+    for p in $pid
+    do
+        # Send signal to process group
+        kill -ABRT -$p
+    done
+
+    rm -f /var/lock/subsys/$prog
+    echo_success
+    echo
+    return 0
+}
+
+a2pkill() {
+    pid="`pidof $prog`"
+    echo -n "Killing any $prog process: $pid"
+
+    for p in $pid
+    do
+        # Send signal to process group
+        kill -KILL -$p
+    done
+
+    rm -f /var/lock/subsys/$prog
+    echo_success
+    echo
+    return 0
+}
+
+check() {
+    # Check first if we are called to check status file when arg is the DESTID
+    if [ -e "$SHMDIR/.jobstatus-$1" ]; then
+        prog="$AFP2PRINT_PATH/dbm-status-tools.pl"
+        exec perl -I$AFP2PRINT_PATH $prog "$SHMDIR/.jobstatus-$1"
+    fi
+
+    pid="`pidof $prog`"
+    echo -n "Debugging any $prog process: $pid"
+
+    for p in $pid
+    do
+        # Send signal to process group
+        kill -USR1 -$p
+    done
+
+    sleep 1
+
+    echo_success
+    echo
+
+    for file in /tmp/$prog-self$1.log
+    do
+        if [ -s $file ]; then
+            name=${file/*\/}
+            name=${name/-self$1.log}
+            echo "====================$name===================="
+            cat $file
+        fi
+    done
+
+    rm -f /tmp/$prog*-self*.log
+    return 0
+}
+
+rhstatus() {
+    status $prog
+}
+
+restart() {
+      stop
+      sleep 1
+    start
+}
+
+reload() {
+    echo -n "Reloading $prog daemon configuration: "
+    killproc $prog -HUP
+    RETVAL=$?
+    echo
+    return $RETVAL
+}
+
+case "$1" in
+  start)
+      start $2
+    ;;
+  stop)
+      stop
+    ;;
+  abort)
+      abort
+    ;;
+  kill)
+      a2pkill
+    ;;
+  restart)
+      restart
+    ;;
+  reload)
+      reload
+    ;;
+  status)
+      rhstatus
+    ;;
+  test)
+      check "test"
+    ;;
+  debug)
+      check "debug"
+    ;;
+  check)
+      check $2
+    ;;
+  condrestart)
+      [ -f /var/lock/subsys/$prog ] && restart || :
+    ;;
+  *)
+    echo "Usage: ${prog} {start|stop|abort|kill|status|reload|restart|condrestart|test|debug|check}"
+    exit 1
+esac
+
+# Check debug output
+OUTPUT="/var/run/${prog}.debug"
+if [ -s "$OUTPUT" ]; then
+    echo "Debug output for $prog service:"
+    # Strip output from DBI lib warning on RHEL3
+    egrep -v '^(.*/usr/share/mysql/charsets|Character set)' "$OUTPUT"
+    [ "$1" == "stop" -o "$1" == "abort" -o "$1" == "kill" ] && rm -f "$OUTPUT"
+fi
Index: /A2P/a2p/a2p.pl
===================================================================
--- /A2P/a2p/a2p.pl	(revision 3)
+++ /A2P/a2p/a2p.pl	(revision 3)
@@ -0,0 +1,795 @@
+#!/usr/bin/perl
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+BEGIN {
+    use strict ;
+    use warnings ;
+    use POSIX 'setsid' ;
+    use A2P::Globals ;
+
+    our $VERSION = sprintf "%s", q$Rev: 762 $ =~ /(\d[0-9.]+)\s+/ ;
+
+    if (defined($ENV{JAVA_HOME}) and $ENV{JAVA_HOME}) {
+        # Don't fork if launch by Eclipse, script launcher unset JAVA_HOME
+        $Progname = "a2p-eclipse" ;
+        $MUSTQUIT = 1 ;
+
+    } else {
+        # Daemonize early
+        my $forkpid = 0 ;
+        our $argument = $ARGV[0] || "" ;
+        chdir '/'                      or die "Can't chdir to /: $!";
+        open *STDIN , '<', '/dev/null' or die "Can't read from /dev/null: $!";
+        open *STDOUT, '>', $StdoutFile or die "Can't write to $StdoutFile: $!";
+        defined($forkpid = fork)       or die "Can't fork: $!";
+
+        # Save son PID in system file provided as argument if file exists
+        if ( $forkpid > 0 ) {
+            if ( length($argument) > 0 ) {
+                open *PIDFILE , '>', $argument
+                    or die "Can't open PID file '$argument': $!";
+                print PIDFILE $forkpid ;
+                close(PIDFILE);
+            }
+            # and leave our son alone
+            exit(0);
+        }
+
+        my $priority = getpriority( 0, $$ );
+        if ( $priority < 10 ) {
+            # Increase our priority
+            setpriority 0, 0, $priority + 5
+                or die "Can't update priority: $!" ;
+        }
+    }
+}
+our $VERSION  ;
+our $argument ;
+our $Progname ;
+our $MUSTQUIT ;
+
+#--------------------------------------------------------------------------
+# Here we import any needed modules only after we are in background
+#--------------------------------------------------------------------------
+
+use strict   ;
+use warnings ;
+use integer  ;
+use POSIX qw( :signal_h :sys_wait_h setsid );
+use Time::HiRes qw( usleep gettimeofday tv_interval );
+use A2P::Init    ;
+use A2P::Globals ;
+use A2P::Globals qw( UpdateSharedEnv ) ;
+use A2P::Syslog  ;
+use A2P::Com qw( GetCom IsCom comCOM comREQ comLOG comJOB comDONE );
+use A2P::Signal  ;
+use A2P::threads ;
+use A2P::threads qw(
+    SetNewLogger ThreadsStarter ThreadsChecker THCountAll is_son
+    THCountStopping FromToDoCom CheckChildrenQuitTimeOut is_really_logger
+    threads_internal_updates THList threadSleep reduceSleep
+    ) ;
+use A2P::Thread ;
+use A2P::Logger ;
+use A2P::BackEnd ;
+use A2P::Listener ;
+use A2P::Archiver ;
+use A2P::EService ;
+use A2P::Converter ;
+use A2P::JobManager ;
+use A2P::SpoolManager ;
+use A2P::Signal  'LogSigMessage' ;
+
+&Debug(" Module load error: $! $? $@") if ( $! or $? or $@ );
+&Debug(" =============================START==============================");
+
+&setsid                     or die "Can't set a new session: $!";
+open *STDERR, '>&', *STDOUT or die "Can't redirect STDERR to STDOUT: $!";
+
+#-------------------------------------
+# Here we are in a daemonized process
+#-------------------------------------
+
+&Debug("Current progname = $0, version $VERSION, started");
+&Debug("Setting service name to $Progname");
+# Update system name of this daemon to be pretty with ps command
+$0 = $Progname ;
+
+# Reset error code
+$! = 0 ;
+
+# Declarations in threads.pm
+# Empty Sons/Threads lists and hashs, hash keys are processes PID
+%sons    = () ;
+%HasQuit = () ;
+@answers = () ;
+
+my %requests = () ;
+
+#############################################################################
+sub InitCheck {
+    # AFPSPOOL must be correctly defined and checked at any update
+    unless ( -d $AFPSPOOL ) {
+        &Alert("abterm: AFPSPOOL '$AFPSPOOL' folder doesn't exist");
+        return ++$MUSTQUIT ;
+    }
+
+    # Check needed folders
+    my %Folders = (
+        LOCKID_FOLDER =>  $AFPSPOOL . '/.a2p',
+        SERVICE_TMP   =>  $SERVICE_TMP,
+        SHMDIR        =>  $SHMDIR,
+        ERRORSPOOL    =>  $ERRORSPOOL,
+        DONESPOOL     =>  $DONESPOOL,
+        STATS_FOLDER  =>  $STATS_FOLDER
+        );
+
+    while ( my ($var, $Path) = each(%Folders) ) {
+        unless ( -d $Path ) {
+            &Info("Creating $Path folder as $var");
+            my $Folder = "" ;
+            foreach my $tmp_path ( split(m{[/]+}, $Path) ) {
+                $Folder .= "/$tmp_path" ;
+                mkdir $Folder , oct(775) unless ( -d $Folder );
+                &Error("Can't create '$Path' folder as $var: $!"), last
+                    unless ( -d $Folder );
+            }
+        }
+    }
+
+    # Initialize SERVICE_TMP folder
+    if ( -d $SERVICE_TMP ) {
+        unless ( system("touch $SERVICE_TMP/init_$Progname") == 0 ) {
+            &Error("Can't initialize $SERVICE_TMP folder: $!");
+            $MUSTQUIT = 1 ;
+        }
+
+    } else {
+        &Error("Can't initialize unavailable $SERVICE_TMP folder: $!");
+        $MUSTQUIT = 1 ;
+    }
+
+    # MAXTASK must be greater or equal to 1
+    if ( $MAXTASK < 1 ) {
+        &Info("Setting MAXTASK to 1 as it is lower: ".$MAXTASK);
+        $MAXTASK = 1 ;
+    }
+
+    if ( $MAX_BUFFER_SIZE < 8192 ) {
+        &Info("Setting MAX_BUFFER_SIZE to 8192 as it is lower: " .
+            $MAX_BUFFER_SIZE );
+        $MAX_BUFFER_SIZE = 8192 ;
+    }
+
+    # Test opening logfile in case of file logging
+    if ( $LOGFILENAME and ( $LOGFILE_VS_SYSLOG or $DEBUG_IN_FILE )) {
+        $! = 0 ;
+        unless (open(*LOG, '>', $LOGFILENAME)) {
+            $LOGFILE_VS_SYSLOG = 0 ;
+            $DEBUG_IN_FILE     = 0 ;
+            return &Error("Can't open '$LOGFILENAME': $!");
+        }
+
+        if ( $LOGFILE_PURGE ) {
+            &UPSTAT('PURGE-LOG');
+            truncate LOG , 0 ;
+            $LOGFILE_PURGE = 0 ;
+        }
+
+        close(LOG);
+    }
+
+    # Reset Debug comportement
+    &ResetDebug() ;
+
+    &threads_internal_updates();
+}
+################################################################################
+
+&InitCheck ;
+
+$STATS{'A2P-VERSION'} = A2P_RPM_VERSION ;
+
+$maintid = $$ ;
+
+map {
+    if ( ! $MUSTQUIT and &ThreadsStarter( $_ , 1 ) != $SonKind{$_} * $MAXTASK ) {
+        &Error("Fatal error can start a thread");
+        $MUSTQUIT ++ ;
+    }
+} keys(%SonKind) ;
+
+&Debug(&THCountAll . " modules started");
+
+&SetNewLogger(-1) if (&THCountAll); # First logger initialization
+
+my ( $Get, @Temp, $MaxAnswers, $busyby, @RollChilds, @KeptAnswers );
+my %LastGetRequests ;
+my @MarkTimer = &gettimeofday() ;
+$started = 0 ;
+my %logtimeout = () ;
+my $lastcheck  = [ &gettimeofday() ];
+my $SleepFactor = 1 ;
+
+# Empty lists to rotate getanswers other childs and to keep answers
+@KeptAnswers = () ;
+@RollChilds  = () ;
+
+$MaxAnswers = $COM_BURST ? 100 * $COM_BURST : 100 ;
+
+# Hack to handle some rare cut answer
+my @bad_answer = () ;
+
+# Threads handler will loop only if threads are availables
+while ( keys(%sons) and ! $MUSTQUIT ) {
+    &TIMESTAT('MainLoop');
+
+    &LogSigMessage();
+
+    A2P::Thread::self_TEST() if $do_test ;
+
+    @MarkTimer = &gettimeofday() , &Info("---MARK---")
+        unless ( &tv_interval(\@MarkTimer) < 1800 );
+
+    #######################
+    # Check communication
+    #######################
+
+    # First get any new Com from childs
+    # 1. Update our child list if empty
+    @RollChilds = keys(%sons) unless @RollChilds ;
+
+    # 2. Update answers list if not full and when we have child to getanswers
+    while ( @RollChilds ) {
+        my $OneSon = shift @RollChilds ;
+        next unless &is_son($OneSon);
+        next if ( @answers > $MaxAnswers
+            and defined($LastGetRequests{$OneSon})
+            and &tv_interval($LastGetRequests{$OneSon}) < 2 );
+        $LastGetRequests{$OneSon} = [ &gettimeofday() ];
+        my @SonAnswers = $sons{$OneSon}->getAnswers() ;
+        push @answers , @SonAnswers ;
+        &UPSTAT('GETANSWERS', scalar(@SonAnswers));
+    }
+
+    # 3. Only sleep when have nothing to tell or to few new request has arrived
+    &UPSTAT('LOOPS');
+    @answers ? &reduceSleep() : &threadSleep() ;
+
+    # 4. Reintegrate last kept answers to the end only if we have not
+    #    something more urgent to do
+    # By default we will read current answers
+    if (@KeptAnswers) {
+        $LastGetRequests{'KeptAnswers'} = [ &gettimeofday() ]
+            unless (defined($LastGetRequests{'KeptAnswers'}));
+
+        if ( ! @answers or &tv_interval($LastGetRequests{'KeptAnswers'})>= 1 ) {
+            push @answers, @KeptAnswers ;
+            @KeptAnswers = () ;
+            $LastGetRequests{'KeptAnswers'} = [ &gettimeofday() ];
+        }
+    }
+
+    &MAXSTAT('answers-KEPT',scalar(@KeptAnswers));
+    &MAXSTAT('answers-COUNT',scalar(@answers));
+
+    # 5. Then check COM_BURST answers max
+    my $max = $COM_BURST ;
+    while ( $max --  and defined( $Get = shift @answers )) {
+        chomp($Get);
+
+        my ( $Id , $Req ) = &IsCom( comCOM , $Get );
+
+        # 6. Empty COM should not exist but just in case
+        unless ( $Get ) {
+            &debugdev("Skipping unexpected empty COM '$Get'");
+            next ;
+        }
+
+        # 7. Check $Get is really a COM
+        unless ( defined($Id) and defined( $Req ) ) {
+            if ($Get =~ /^[<]/) {
+                my $ref ;
+                &UPSTAT('COM-CHECK-FRAGMENT');
+                # Control this com is still not handled
+                if (($ref) = grep { $_->[0] eq $Get } @bad_answer ) {
+                    # Don't keep too much time
+                    next if (++ $ref->[1] < 100);
+
+                } else {
+                    # Will try to reassemble a fragmented com
+                    push @bad_answer, [ $Get, 0 ] ;
+                    next ;
+                }
+
+            } elsif (@bad_answer) {
+                # Try to assemble and reinject immediatly
+                my $try = shift @bad_answer ;
+                unshift @answers, $try->[0] . $Get ;
+                &Info("Trying reassembled com: " . $try->[0] . $Get);
+                &UPSTAT('COM-REASSEMBLED');
+                next ;
+            }
+
+            &Error("[DEV] Can't understand answer '$Get'");
+            &UPSTAT('COM-BAD-FRAGMENT');
+            next ;
+        }
+
+        # 8. Check if we just got a number as COM shortcut
+        if ( $Req =~ /^\d+$/ ) { # Got a scalar
+            &UPSTAT('GETNUMCOM');
+
+            if ( $Req == QUIT ) {
+                &UPSTAT('GETQUITCOM');
+
+                # Should now delete this thread from list
+                if (&is_son($Id)) {
+                    &Debug("Received QUIT from " . $sonname{$Id} );
+
+                    $HasQuit{$Id} = $sonname{$Id} ;
+
+                    # A thread has quit, so we must restart it unless
+                    #  we are quitting or we have ask it to stop
+                    if ($sons{$Id}->StoppingSince()) {
+                        $sons{$Id}->Delete();
+
+                    } else {
+                        my $kind = $sons{$Id}->getKind ;
+                        $sons{$Id}->Delete();
+                        unless ( $do_quit or $MUSTQUIT ) {
+                            &ThreadsChecker( $kind );
+                            &Info("Module $kind restarted");
+                        }
+                    }
+
+                } else {
+                    # Check threads later in we need to restart some child
+                    $do_check ++ ;
+                    &Debug("Received QUIT from " . $sonname{$Id} .
+                        ", should check what's happened");
+                }
+
+            } elsif (&is_son($Id)) {
+                if ( $Req == PING ) {
+                    &UPSTAT('GETPINGCOM');
+
+                    &Debug("Received PING from " . $sonname{$Id} );
+                    $sons{$Id}->GotPing();
+
+                } elsif ( $Req == _INIT ) {
+                    &UPSTAT('GETINITCOM');
+
+                    &Debug("Received INIT from " . $sonname{$Id} );
+                    $sons{$Id}->GotInit();
+
+                } elsif ( $Req == comDONE ) {
+                    &UPSTAT('GETCOMDONE');
+
+                    &Debug("Received comDONE from " . $sonname{$Id} )
+                        if $ADVANCED_DEBUGGING ;
+                    $sons{$Id}->ResetRemoteBufSize();
+
+                } else {
+                    &UPSTAT('GETBADCOM');
+
+                    &Error("[DEV] Don't understand com '$Get' as Req=" .
+                        ( defined($means{$Req}) ? $means{$Req} : $Req ) .
+                        " from " . $sonname{$Id} );
+                }
+
+            } elsif (defined($HasQuit{$Id})) {
+                if ($HasQuit{$Id}) {
+                    &UPSTAT('GETDEADCOM');
+
+                    # Son still has QUIT and is deleted
+                    &Debug("Received Req=" .
+                        ( defined($means{$Req}) ? $means{$Req} : $Req ) .
+                        " from dead thread T$Id" );
+
+                } else {
+                    &UPSTAT('GETBADCOM');
+
+                    &Error("[DEV] Received Req=" .
+                        ( defined($means{$Req}) ? $means{$Req} : $Req ) .
+                        " for thread T$Id" );
+                }
+
+            } else {
+                &UPSTAT('GETBADCOM');
+
+                &Error("[DEV] Unsupported com '$Get' as Req=" .
+                    ( defined($means{$Req}) ? $means{$Req} : $Req ) .
+                    " from thread T$Id" );
+            }
+
+            # Numeric COM analysed so looping on next answer
+            next ;
+        }
+
+        # 9. Manage log message:
+        # 9.1. Enqueue log message if still have some
+        # 9.2. Transmit to logger if running
+        # 9.3. Do our self the log when logger is not available
+        if ( @Temp = &IsCom( comLOG , $Req )) {
+            &UPSTAT('GETLOGCOM');
+            unless ( @Temp == 2 and $Temp[1] ) {
+                &UPSTAT('BAD-LOGCOM');
+                &Debug("Found bad log request '$Req'");
+                next ;
+            }
+
+            if (&is_really_logger($loggertid)) {
+                # 9.2. Just transmit log to logger
+                $sons{$loggertid}->AskThread( TODO , $Req );
+
+            } else {
+                # 9.3. Finally try to log directly if Logger not available
+                &SetNewLogger(0) if $loggertid ;
+                &DirectLog( $Temp[0] , [ $Temp[1] ] , "MAIN:" );
+            }
+            next ;
+        }
+
+        # 10. Manage requests from ourself, JobManager and Listener
+        if ( @Temp = &IsCom( comREQ , $Req )) {
+            &UPSTAT('GETREQCOM');
+            unless ( @Temp == 2 and $Temp[1] ) {
+                &UPSTAT('GETBADREQCOM');
+                &Debug("Found bad REQ request '$Req'");
+            }
+
+            if (&is_son($Id) or $Id == $$) {
+                &Debug((($Id == $$)? "I am" : $sonname{$Id} . " is" )
+                    . " requesting $Temp[1] to $Temp[0]");
+
+                # if @threads list is empty we don't find available thread
+                unless ( &FromToDoCom( $Id , @Temp ) ) {
+                    &UPSTAT('BUSY-MODULE');
+
+                    &Debug("No $Temp[0] thread available, keep request");
+                    push @KeptAnswers , $Get ;
+                }
+
+            } elsif (defined($HasQuit{$Id})) {
+                if ($HasQuit{$Id}) {
+                    &UPSTAT('GETDEADREQCOM');
+                    # Son still has QUIT and is deleted, still try to send it if
+                    # it is for JobManager
+                    if ($Temp[0] =~ /^JobManager$/) {
+                        &Debug("Transmitting request $Temp[1] from dead " .
+                            $sonname{$Id} . " to $Temp[0] thread as myself");
+                        unshift @answers , &GetCom( comCOM, $$ => $Req );
+
+                    } else {
+                        &Debug("Won't transmit request $Temp[1] from dead " .
+                            $sonname{$Id} . " to $Temp[0] thread");
+                    }
+
+                } else {
+                    &UPSTAT('GETBADREQCOM');
+                    &Error("Can't transmit request $Temp[1] from " .
+                        $sonname{$Id} . " to $Temp[0] thread");
+                }
+
+            } else {
+                &UPSTAT('GETBADREQCOM');
+                &Error("[DEV] Unsupported req $Temp[1] from " .
+                    $sonname{$Id} . " to $Temp[0]");
+            }
+            next ;
+        }
+
+        # 11. Com should come from still alive thread
+        if ( ! &is_son($Id) ) {
+            &Info("Forgetting com $Req as " . $sonname{$Id} . " is dead");
+
+        # 12. Manage answers from busy threads BackEnd, SpoolManager, Converter
+        #     and Archivage
+        } elsif ( $busyby = $sons{$Id}->isBusyBy ) {
+            # 12.a This must be an answer for another thread
+            @Temp = &IsCom( comJOB , $Req );
+
+            # 12.b Handle JOB comDONE
+            if ( @Temp and &IsCom( comDONE , $Temp[1] )) {
+                # Cancel business only when we receive a comDONE
+                &Debug("JobDone received from " . $sonname{$Id} );
+                $sons{$Id}->setReady();
+                # Thread is now ready to receive another request
+
+            # 12.c Check business is not lost
+            } elsif (defined($HasQuit{$busyby})) {
+                &UPSTAT('DEAD-REQUESTER');
+
+                if ($HasQuit{$busyby}) {
+                    # Son still has QUIT and is deleted
+                    &Debug("Delete answer $Req from T$Id to dead $busyby");
+
+                } else {
+                    &Error("Delete request $Req from T$Id to ghost $busyby");
+                }
+
+            } elsif ( $busyby == $$ ) {
+                # This is an answer for parent thread
+                if ( $Req =~ /^started$/i and &is_son($Id)) {
+                    if ($sons{$Id}->is('JobManager')) {
+                        &Info("$Progname service v".A2P_RPM_VERSION." started");
+                        &FromToDoCom( $$ , Listener => 'STARTED' )
+                            or &Error("Can't tell Listener we are started");
+
+                    } elsif ($sons{$Id}->is('Listener')) {
+                        &Debug("Listener is informed we have started");
+
+                    } else {
+                        &debugdev("Bad STARTED answer from " . $sonname{$Id});
+                    }
+                    $sons{$Id}->setReady ;
+
+                } else {
+                    &debugdev("Found '$Req' answer from " . $sonname{$Id});
+                }
+
+            } else {
+                &debugdev("Bad answer $Req from T$Id and for T$requests{$Id}");
+            }
+
+            next ;
+        }
+
+        # We should never come there
+        &UPSTAT('GETBADCOM');
+        &debugdev("'$Req' from " . $sonname{$Id} . " no more supported");
+        &debugdev("Next com to get is '$answers[0]'") if (defined($answers[0]));
+        &debugdev("Then com will be '$answers[1]'")   if (defined($answers[1]));
+
+    } # Loop on COMBURST answers
+
+    #######################
+    # Check flags
+    #######################
+
+    # Quit only when no job is being converted, and we're not still quitting
+    # Any Job in error will be lost
+    if ($MAXTASK and $do_quit ) {
+        if ( $do_quit == 1 ) {
+            &Info("Waiting until threads have quit");
+
+            # Divide USLEEP by 2 to accelerate communications
+            $USLEEP >>= 1 ;
+
+            # Firstly, ask JobManager to not do any more jobs by
+            # setting its MAXJOBS env to 0, it should quit when lasts are done
+            map {
+                $sons{$_}->AskInit('$ENV{MAXJOBS} = 0');
+                $sons{$_}->AskInit('CAN_UPDATE_NOW');
+            } &THList('JobManager') ;
+
+            # Secondly, ask threads to update USLEEP
+            map {
+                $sons{$_}->AskInit('$ENV{USLEEP} = ' . $USLEEP);
+            } keys(%sons) ;
+
+            $do_quit ++ ;
+
+        } elsif ( $do_quit == 2 ) {
+            # Secondly, just check if JobManager has quit before switching
+            # To normal quit
+            $do_quit ++ unless &THList('JobManager');
+
+        } else {
+            # Normal quit by asking all processes to quit
+
+            &Debug("Setting MAXTASK to 0");
+            $MAXTASK = 0 ;
+
+            &Debug("Asking threads to stop");
+            map {
+                $sons{$_}->AskToStop()
+                    or &Info("Can't asking " . $sonname{$_} . " to quit")
+            } keys(%sons) ;
+
+            &SetNewLogger(0);
+
+            # We can safely activate debugging when quitting is requested
+            $NO_SYSLOG_DEBUG = 0 if $SERVICE_DEBUG ;
+        }
+
+    } elsif ( $do_quit > 4 ) {
+        $MUSTQUIT ++ ;
+
+    } elsif ( $do_quit ) {
+        &CheckChildrenQuitTimeOut() ;
+    }
+
+    if ($Childquit) {
+        my $pid = 0 ;
+        &Debug("$Childquit SIGCHLD received");
+        while ($Childquit > 0 and ! $MUSTQUIT and $pid = waitpid(-1,&WNOHANG)) {
+            &Debug("SIGCHLD with pid = $pid");
+            last if ( $pid < 0 );
+            if (defined($sons{$pid})) {
+                $Childquit -- ;
+
+                my $kind = $sons{$pid}->getKind ;
+                my $isLogger = $sons{$pid}->is('Logger');
+
+                # Get answers just in case we missed last QUIT
+                push @answers , $sons{$pid}->getAnswers ;
+
+                &Debug($kind."[".$sonname{$pid}."] returns with code ".($?>>8));
+
+                &SetNewLogger(0) if $isLogger ;
+
+                # We should better push the pid in a list to check it elsewhere
+                $HasQuit{$pid} = $sonname{$pid} ;
+
+                # Check if we need to restart the thread
+                if ( ! $do_quit and ! $MUSTQUIT ) {
+                    if (&ThreadsChecker( $kind )) {
+                        &Info("Module $kind thread restarted");
+                        &SetNewLogger(-1) if $isLogger ;
+
+                    } else {
+                        &Alert("Aborting as I can't restart $kind thread");
+                        $do_quit ++ ;
+                    }
+                }
+            }
+            &Debug("T$pid has terminated");
+        }
+        $do_check ++ unless ( $Childquit > 0 or $do_quit or $MUSTQUIT );
+        $Childquit = 0 ;
+    }
+
+    if ($MAXTASK and $do_init) { # >0 after HUP signal has been received
+        $do_init = 0 ;
+
+        # Reload configuration
+        my @Updates = &Init() ;
+
+        if (@Updates) {
+            # First update ourself
+            map { eval "$_" } @Updates ;
+            &UpdateSharedEnv ;
+            &InitCheck ;
+
+            # And transmit to children any modification
+            map {
+                my $tid = $_ ;
+                map { $sons{$tid}->AskInit($_) } @Updates, 'CAN_UPDATE_NOW' ;
+            } keys(%sons) ;
+
+            # Here we can have to load some threads or
+            # unload some so just check threads
+            $do_check ++ ;
+        }
+
+        # Now we can start has threads are initialized
+        if ( ! $started ++ ) {
+            unless (&FromToDoCom( $$ , JobManager => 'START' )) {
+                &Error("Can't ask JobManager to start, aborting");
+                $do_quit ++ ;
+            }
+        }
+
+        $MaxAnswers = $COM_BURST ? 1000 * $COM_BURST : 1000 ;
+    }
+
+    $do_check ++ if ( &tv_interval($lastcheck) - 5 > 0 );
+
+    if ($MAXTASK and $do_check and ! $do_quit and ! $MUSTQUIT) {
+
+        $do_check = 0 ;
+        $lastcheck = [ &gettimeofday() ];
+
+        # Call checker only for threads not still in check mode but also
+        # force check when quitting as this is the way to advertize threads
+        map {
+            if ( $sons{$_}->isToCheck ) {
+                $do_ping ++ ;
+                &Debug("Checking " . $sonname{$_} . "...");
+                $sons{$_}->Check() if $sons{$_}->isAlive();
+            }
+        } keys(%sons) ;
+        &Debug("No thread to check") unless $do_ping ;
+
+        # Also check threads numbers
+        &ThreadsChecker();
+    }
+
+    if ($MAXTASK and $do_ping) {
+        map {
+            if ( $sons{$_}->Ping() ) {
+                &Debug("Ping " . $sonname{$_} . " thread");
+                $do_ping -- ;
+            }
+        } keys(%sons);
+    }
+
+}
+
+# Be sure to keep debugging information when stopping
+$NO_SYSLOG_DEBUG = 0 ;
+
+&LogSigMessage ;
+# Do some check while quitting
+&Debug(&THCountStopping . " modules stopping") if &THCountStopping;
+if ( &THCountAll ) {
+    &Debug(&THCountAll . " modules running, asking them to stop");
+    map {
+        $sons{$_}->AskToStop()
+            or &Info("Can't asking " . $sonname{$_} . " to quit")
+    } keys(%sons) ;
+}
+&Info("$Progname service is stopping");
+
+# Wait until every child has quit
+while ( &THCountAll or &THCountStopping ) {
+    &CheckChildrenQuitTimeOut() unless $Childquit ;
+    @MarkTimer = &gettimeofday() , &Debug("---QUITTING---")
+        unless ( &tv_interval(\@MarkTimer) < 1 );
+    &Debug("$Childquit SIGCHLD received") if $Childquit ;
+    while ( $Childquit > 0 ) {
+        $Childquit -- ;
+        my $pid ;
+        while ( $pid = waitpid(-1,&WNOHANG) ) {
+            last unless ( $pid > 0 and defined($sonname{$pid}));
+            delete $sons{$pid};
+            &Debug("$sonname{$pid} has terminated");
+            $HasQuit{$pid} = $sonname{$pid};
+        }
+    }
+    $Childquit = 0 if ( $Childquit < 0 );
+    usleep $USLEEP ;
+}
+
+while ( my $pid = wait ) {
+    last if ( $pid < 0 );
+    delete $sons{$pid} if (defined($sons{$pid}));
+    &Debug("T$pid has terminated");
+}
+
+unlink $LISTENER if ( -S $LISTENER );
+if (defined($argument)) {
+    &Debug("PID file = '$argument'");
+
+    # Delete our PID in PID file
+    open *RET , '>', $argument or die "Can't open PID file '$argument': $!" ;
+    print RET "0" ;
+    close(RET);
+}
+
+&LogSigMessage ;
+&Info("$Progname service stopped");
+
+exit(0);
+
+END {
+    # Output statistics when quitting from a disgnostic service
+    A2P::Thread::self_TEST() if ($Progname =~ /^diagnostics/);
+
+    $$ == $maintid ?
+    &Debug("=============================QUIT===============================")
+    :
+    &Debug($0 . "[$$] =====QUIT=====");
+}
Index: /A2P/a2p/a2p.sh
===================================================================
--- /A2P/a2p/a2p.sh	(revision 3)
+++ /A2P/a2p/a2p.sh	(revision 3)
@@ -0,0 +1,313 @@
+#!/bin/sh
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# a2p: This is the init script for starting up a2p.pl
+#
+# chkconfig: 345 99 10
+# description: Starts and stops afp2print backend daemon
+#              that handles threads to process AFPSPOOL
+# processname: a2p
+# pidfile: /var/run/a2p.pid
+
+# Source function library.
+. /etc/init.d/functions
+
+# A2P_SYS_CONF must be a full pathname, daemon need at least this variable
+# to know which file to read when reloading conf
+A2P_SYS_CONF="/etc/afp2print/afpds2tex.conf"
+
+# See how we were called.
+
+# Strip service name from Sxx/Kxx if started during boot or during shutdown
+prog="`basename $0|sed -re 's/^S[0-9]{2}//' -e 's/^K[0-9]{2}//'`"
+pid="`pidof $prog`"
+
+# Delete PID file if service is not running
+[ -z "$pid" -a -s /var/run/$prog.pid ] && rm -f /var/run/$prog.pid
+
+# System configuration integration if not integrated in environment
+if [ -e "$A2P_SYS_CONF" -a -z "$AFPSPOOL" ]; then
+    . "$A2P_SYS_CONF"
+fi
+
+# Optional conf integration
+if [ -n "$prog" -a -e "/etc/afp2print/${prog}.conf" ]; then
+    . "/etc/afp2print/${prog}.conf"
+fi
+
+[ -z "$LOCKID" ] && LOCKID="`hostname -s|tr 'a-z' 'A-Z'`"
+export LOCKID
+
+# Perl library path options to help service to found its needed modules
+PERLOPT=""
+[ -d "$AFP2PRINT_PATH/A2P" ] && PERLOPT="$PERLOPT -I$AFP2PRINT_PATH"
+[ -d "$AFP2PRINT_PATH/printlib/perllib" ] && PERLOPT="$PERLOPT -I$AFP2PRINT_PATH/printlib"
+[ -d "$PRINTLIB_PATH/perllib" ] && PERLOPT="$PERLOPT -I$PRINTLIB_PATH"
+
+# Prepare Perl binary environment
+# Also unset JAVA_HOME in case it is in our ENV as it should exist only during
+# launch by Eclipse IDE
+PERLENV="unset JAVA_HOME ; LANG=C LOCKID=\"$LOCKID\" A2P_SYS_CONF=\"$A2P_SYS_CONF\""
+
+# These defaults can be overided in confs
+: ${AFP2PRINT_USER:=afp2print}
+: ${SERVICE_PROG:=$AFP2PRINT_PATH/a2p.pl}
+: ${SERVICE_DEBUG:=0}
+: ${PERL:=/usr/bin/perl}
+: ${NICE:=nice --5}
+: ${LOGFILENAME:=/var/log/a2p.debug}
+
+start() {
+    # For SELinux we need to use 'runuser' not 'su'
+    SU=su
+    if [ -s /etc/redhat-release ]; then
+        if ! fgrep -q "Red Hat Enterprise Linux ES release 3" /etc/redhat-release; then
+            [ -x /sbin/runuser ] && SU=runuser
+        fi
+    fi
+
+    echo -n "Starting $prog: "
+    if [ -e /var/lock/subsys/$prog ]; then
+        if [ -s /var/run/$prog.pid ] && [ -e /proc/`< /var/run/$prog.pid` ]; then
+            echo -n "cannot start $prog: $prog is already running.";
+            failure "cannot start $prog: $prog already running.";
+            echo
+            return 1
+        fi
+    fi
+
+    # Prepare pid file
+    touch /var/run/${prog}.pid
+    chown $AFP2PRINT_USER /var/run/${prog}.pid
+    chmod 664 /var/run/${prog}.pid
+
+    # Check user will be able to output in LOGFILENAME
+    if (( DEBUG_IN_FILE > 0 || LOGFILE_VS_SYSLOG > 0 )); then
+        touch $LOGFILENAME
+        chown $AFP2PRINT_USER $LOGFILENAME
+        chmod 664 $LOGFILENAME
+    fi
+
+    # Touch the service debug file in case we need to keep some information
+    # Usefull when debugging Perl compilation problems
+    if (( SERVICE_DEBUG > 0 )); then
+        touch /var/run/${prog}.debug
+        chown $AFP2PRINT_USER /var/run/${prog}.debug
+        if [ "$1" == "debug" ]; then
+            PERLOPT="$PERLOPT -dt"
+            echo -n "" >/var/run/${prog}.trace
+            chown $AFP2PRINT_USER /var/run/${prog}.trace
+            chmod 664 /var/run/${prog}.trace
+            PERLENV="$PERLENV PERLDB_OPTS=\"NonStop=1 LineInfo=/var/run/${prog}.trace frame=4 dieLevel=2\""
+        fi
+    else
+        rm -f /var/run/$prog.debug
+    fi
+
+    # Start service
+    $NICE $SU - $AFP2PRINT_USER -c "$PERLENV $PERL $PERLOPT $SERVICE_PROG /var/run/$prog.pid"
+    RETVAL=$?
+    [ $RETVAL -eq 0 ] && touch /var/lock/subsys/$prog && success $prog;
+    echo
+    while [ ! -s /var/run/$prog.pid -a $RETVAL -eq 0 ]
+    do
+        usleep 100000
+    done
+    if [ -n "$1" -a -x "/usr/bin/$1" -a -s /var/run/$prog.pid ]; then
+        pid=`</var/run/$prog.pid`
+        if [ "$1" == "strace" ]; then
+            strace -T -a 120 -s 64 -tt -p $pid -f -q -o /var/log/a2p.strace&
+        elif [ "$1" == "ltrace" ]; then
+            ltrace -C -f -T -s 64 -tt -p $pid -o /var/log/a2p.ltrace&
+        fi
+    fi
+    return $RETVAL
+}
+
+stop() {
+    echo -n "Stopping $prog: "
+    if [ ! -e /var/lock/subsys/$prog ]; then
+        echo -n "cannot stop $prog: $prog is not running."
+        failure "cannot stop $prog: $prog is not running."
+        echo
+        return 1;
+    fi
+
+    let RETVAL=0 TOTALRETVAL=0
+    pid="`pidof $prog`"
+
+    for p in $pid
+    do
+        # Send signal to process group
+        kill -TERM $p
+        RETVAL=$?
+        let TOTALRETVAL+=RETVAL
+    done
+
+    [ $TOTALRETVAL -eq 0 ] && rm -f /var/lock/subsys/$prog && echo_success;
+    # Wait max 3 minutes for the service to update its pid to 0 when really quitting
+    let TIMEOUT=1800
+    while [ -s /var/run/$prog.pid -a $RETVAL -eq 0 ]
+    do
+        [ "`< /var/run/$prog.pid`" == "0" ] && break
+        usleep 100000
+        (( --TIMEOUT == 0 )) && break
+    done
+    [ -s /var/run/$prog.pid ] && [ "`< /var/run/$prog.pid`" -gt 0 -a $RETVAL -eq 0 ] && RETVAL=1
+    echo
+    return $RETVAL
+}
+
+abort() {
+    pid="`pidof $prog`"
+    echo -n "Aborting any $prog process: $pid"
+
+    for p in $pid
+    do
+        # Send signal to process group
+        kill -ABRT -$p
+    done
+
+    rm -f /var/lock/subsys/$prog
+    echo_success
+    echo
+    return 0
+}
+
+a2pkill() {
+    pid="`pidof $prog`"
+    echo -n "Killing any $prog process: $pid"
+
+    for p in $pid
+    do
+        # Send signal to process group
+        kill -KILL -$p
+    done
+
+    rm -f /var/lock/subsys/$prog
+    echo_success
+    echo
+    return 0
+}
+
+check() {
+    pid="`pidof $prog`"
+    echo -n "Debugging any $prog process: $pid"
+
+    for p in $pid
+    do
+        # Send signal to process group
+        kill -USR1 -$p
+    done
+
+    sleep 1
+
+    echo_success
+    echo
+    for p in $pid
+    do
+        echo "Check for $p:"
+        for file in /tmp/$prog-*$pid-self$1.log
+        do
+            if [ -s $file ]; then
+                name=${file/*\/}
+                name=${name/-$pid-self$1.log}
+                echo "====================$name===================="
+                cat $file
+            fi
+        done
+    done
+    rm -f /tmp/$prog-*$pid-self*.log
+    return 0
+}
+
+rhstatus() {
+    status $prog
+}
+
+restart() {
+      stop
+      sleep 1
+    start
+}
+
+reload() {
+    echo -n "Reloading $prog daemon configuration: "
+    killproc $prog -HUP
+    RETVAL=$?
+    echo
+    return $RETVAL
+}
+
+case "$1" in
+  start)
+      start $2
+    ;;
+  stop)
+      stop
+    ;;
+  abort)
+      abort
+    ;;
+  kill)
+      a2pkill
+    ;;
+  restart)
+      restart
+    ;;
+  reload)
+      reload
+    ;;
+  status)
+      rhstatus
+    ;;
+  test)
+      check "test"
+    ;;
+  debug)
+      check "debug"
+    ;;
+  check)
+      check $1
+    ;;
+  ask)
+      shift
+    exec $PERL $PERLOPT -we '
+    BEGIN { use A2P::Globals; our $Progname = $ARGV[0] }
+      use A2P::Client;
+      print "\nTesting: " . join(", ",@ARGV) . "\n" ;
+      &DoJob( $ARGV[1] => $ARGV[2] )' "$prog-ask" $prog "$1"
+    ;;
+  condrestart)
+      [ -f /var/lock/subsys/$prog ] && restart || :
+    ;;
+  *)
+    echo "Usage: ${prog} {start|stop|abort|ask|kill|status|reload|restart|condrestart|test|debug}"
+    exit 1
+esac
+
+# Check debug output
+if [ -s /var/run/${prog}.debug ]; then
+    echo "Debug output for $prog service:"
+    cat /var/run/${prog}.debug
+    [ "$1" == "stop" -o "$1" == "abort" -o "$1" == "kill" ] && rm -f /var/run/${prog}.debug
+fi
Index: /A2P/a2p/dbm-status-tools.pl
===================================================================
--- /A2P/a2p/dbm-status-tools.pl	(revision 3)
+++ /A2P/a2p/dbm-status-tools.pl	(revision 3)
@@ -0,0 +1,436 @@
+#! /usr/bin/perl
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+use strict ;
+use Time::HiRes qw( usleep gettimeofday tv_interval) ;
+use Fcntl qw(:flock);
+use GDBM_File ;
+use Storable qw( freeze thaw );
+use Data::Dumper;
+use A2P::Globals ;
+use A2P::Status ;
+use A2P::JobStatus ;
+
+my $jobstatus_base = A2P::JobStatus::dbm_base() ;
+
+$LOCKID = shift @ARGV if @ARGV ;
+
+my $gdbm = ( $LOCKID =~ /^\// and -e $LOCKID )?
+    $LOCKID : $jobstatus_base . $LOCKID ;
+
+# Check file is really a dbm file with 'file' command
+my @control = qx/file $gdbm/ =~ /(dbm).*(database)/i ;
+
+unless ( -e $gdbm and @control == 2 ) {
+    die "File $gdbm not found\n" .
+        "First argument must be the LOCKID for which you to manage status\n" ;
+}
+
+print "Reading $gdbm memory file (".(-s $gdbm).")\n" ;
+my %gdbm ;
+
+sub error {
+    map { print "$_\n" } @_ ;
+    return 0 ;
+}
+
+my $LCK ;
+my ( $uid, $gid );
+sub get_gdbm {
+    return error("File $gdbm doesn't exist")
+        unless -e $gdbm ;
+    my @stat = stat $gdbm ;
+    ( $uid, $gid ) = @stat[4..5] ;
+    open $LCK, '>', $gdbm . '.LCK'
+        or return error("Can't open " . $gdbm . ".LCK locking file: $!");
+    flock $LCK, LOCK_EX
+        or return error("Can't lock on " . $gdbm . ".LCK: $!");
+    tie %gdbm, "GDBM_File", $gdbm, GDBM_WRITER, 0666
+        or return error("Can't tie $gdbm gdbm: $!");
+    1 ;
+}
+
+sub release_gdbm {
+    untie %gdbm ;
+    flock $LCK, LOCK_UN ;
+    close($LCK);
+    chown $uid, $gid, $gdbm ;
+}
+
+sub dump_status {
+    my $this = shift or return "" ;
+    my $dirty = "_".$this->dirty_bit()."_".$this->dirty_bit(3)."____" ;
+    return $this->get_sid_key.": Job ".$this->is_job.
+        " [$this->{STATUS}] step=$this->{STEP}: ".
+        " (".join('',@{$this->{STATE}}).") [Rev$this->{REV}; Sid:$this->{SID} ;"
+        ." dirty bits: $dirty ]" ;
+}
+
+sub confirm {
+    print "Are you sure to do this [y/N] ?" ;
+    my $response = lc(getc);
+    print "\n" ;
+    return $response eq 'y' ? 1 : 0 ;
+}
+
+# Prepare cache and A2P::Status privates
+my $cache = { __GDBM_WRITER__ => 1 };
+my $s = new A2P::Status($cache,\%gdbm,'init');
+$s->remove_from_cache ;
+
+my $quit = 0 ;
+my $index = -1 ;
+my $selected = -1 ;
+my $status ;
+my $name ;
+
+while (!$quit) {
+
+    sleep 1 and next unless (&get_gdbm());
+
+    my @keys = sort(keys(%gdbm)) ;
+    print "===== Service $LOCKID =====\n",
+        "Memory DB keys: ",scalar(@keys)," found\n" ;
+
+    my %keys = map { $_ => 1 } @keys ;
+    my @lost = () ;
+    my %rev  = map {
+        delete $keys{$_} ;
+        /^(.+)_rev$/ ;
+        push @lost , $_ unless (exists($gdbm{$1}));
+        $_ => thaw($gdbm{$_})
+        } grep { /_rev$/ } @keys ;
+
+    print "Lost revisions (".scalar(@lost)."): @lost\n"
+        if ( @lost = sort(@lost) );
+
+    my %ref = map {
+        delete $keys{$_} ;
+        $_ => $gdbm{$_}
+    } grep { ($gdbm{$_} =~ /^\d+$/ and exists($gdbm{'_SID_'.$gdbm{$_}})) or
+                exists($gdbm{$gdbm{$_}}) } keys(%keys) ;
+    my @ref = sort(keys(%ref)) ;
+    print "References found: ", scalar(@ref), "\n" ;
+
+    my %status = map {
+        delete $keys{$_} ;
+        $_ => thaw($gdbm{$_})
+    } grep { $gdbm{$_} =~ /\x04/ } keys(%keys) ;
+    my @status = sort(keys(%status)) ;
+    print "Status    found: ", scalar(@status), "\nRevisions found: ",
+        scalar(keys(%rev)), "\n" ;
+    my $count = 2*@status + @ref ;
+    if ( $count == @keys ) {
+        print "Count is coherent\n" ;
+    } else {
+        print "Bad count found: ".(@keys - $count)." more keys found\n" ;
+    }
+
+    my @unexpected = sort(keys(%keys)) ;
+    print "Not expected keys: @unexpected\n" if @unexpected;
+
+    my $_SID_count = grep { /^_SID_(\d+)$/ } keys(%status) ;
+    my $_SID_rev_count = grep { /^_SID_(\d+)_rev$/ } keys(%rev) ;
+    print "_SID_# count: $_SID_count (+$_SID_rev_count _rev)\n" ;
+
+    &release_gdbm() ;
+
+    if ($selected>=0) {
+        $name = $status[$selected] ;
+        $status = $status{$name} ;
+
+    } elsif ($selected > $#status) {
+        $selected = $#status ;
+        $name = $status[$selected] ;
+        $status = $status{$name} ;
+    }
+
+    unless (defined($status[$selected]) and $name == $status[$selected]) {
+        $selected = -1 ;
+        $name = $status = undef ;
+    }
+
+    # Actions
+    my $a = 0 ;
+    while (!$quit) {
+    print "\n",
+          "q -> Quit             l -> list jobs      m -> list refs         \n",
+          "r -> Refresh          e -> evaluation     j -> select a job      \n",
+          "s -> Shrink dbm       d -> delete job     v -> validate job      \n",
+          "a -> list job refs    x -> dump dbm keys  u -> unselect job      \n",
+          "t -> list twin jobs                                              \n",
+          "f -> Flush lost/unexpected or done                               \n",
+          "[0-9] -> select a job  n/p -> next/previous indexed jobs list    \n"
+          unless ( $a ++ % 5 );
+    if ($index>=0) {
+        print "Current index = $index\n" ;
+        for my $i ( 0..9 ) {
+            if (defined($status[$index+$i])
+            and exists($status{$status[$index+$i]})) {
+                my $this = $status{$status[$index+$i]} ;
+                print "$i - ",dump_status($this),"\n" ;
+            } elsif (defined($status[$index+$i])) {
+                print "$i - Unavailable ",$status[$index+$i],"\n" ;
+            }
+        }
+    }
+    print "DB memory file size: ".(-s $gdbm)."\n" ;
+    print "Selected job '$name': ", dump_status($status), "\n", Dumper($status),
+        "('$name' selected, type 'u' to unselect it)\n"
+        if (defined($name) and defined($status));
+    print "Command ? " ;
+    system "stty", '-icanon', 'eol', "\001";
+    my $key = lc(getc) ;
+    print "\n" ;
+
+    $quit ++ if ($key eq 'q'); # Quit
+    last     if ($key eq 'r'); # Refresh
+
+    if ($key eq 'j') {
+        print "Job: " ;
+        system "stty", 'icanon', 'eol', '^@' ;
+        my $job = <STDIN> ;
+        chomp($job);
+        if (exists($status{$job})) {
+            $status = $status{$job} ;
+        } else {
+            print "$job doesn't exists\n";
+        }
+
+    } elsif ($key eq 'u') {
+        undef $name ;
+        undef $status ;
+        $selected = -1 ;
+
+    } elsif ($key eq 'e') {
+        print "Evaluation: " ;
+        system "stty", 'icanon', 'eol', '^@' ;
+        my $eval = <STDIN> ;
+        chomp($eval);
+        print eval $eval, "\n" ;
+
+    } elsif ($key eq 'v' and defined($name) and defined($status)) {
+        get_gdbm ;
+        if (tied(%gdbm) and confirm) {
+            $status->{STATUS} = 'DONE' ;
+            $status->{STATE}->[12] = 'o' ;
+            $status->{REV} += 100 ;
+            $status->set_dirty_bit(3) ;
+            $status->cache_timer ;
+            $gdbm{$name} = freeze($status) ;
+        }
+        release_gdbm ;
+        last ; # Refresh
+
+    } elsif ($key eq 'd' and defined($name) and defined($status)) {
+        get_gdbm ;
+        $status->remove_from_tied_hash if (tied(%gdbm) and confirm);
+        release_gdbm ;
+        # Select next
+        $selected += $selected < $#status ? 1 : -1 ;
+        $status = $status{$status[$selected]} ;
+        $name = $status[$selected] ;
+        last ; # Refresh
+
+    } elsif ($key eq 'f') {
+        get_gdbm ;
+        if (tied(%gdbm) and confirm) {
+            if (@lost or @unexpected) {
+                map { print '*' ; delete $gdbm{$_} } @lost ;
+                map { print '+' ; delete $gdbm{$_} } @unexpected ;
+
+            } else {
+                my $stop = 0 ;
+                $SIG{INT} = sub { $stop ++ } ;
+                my $i = 0 ;
+                $| = 1 ;
+                foreach $name (keys(%status)) {
+                    $status = $status{$name} ;
+                    last if $stop ;
+                    if ($status->is_abterm
+                    or $status->step_status(12) ne 'o') {
+                        print '-' ;
+                    } else {
+                        delete $gdbm{$name} ;
+                        print '*' ;
+                    }
+                    print ++$i % 100 ? "" : "\n" ;
+                }
+            }
+            print "\n" ;
+        }
+        release_gdbm ;
+        # Remove any selection
+        $selected = -1 ;
+        $status = $name = undef ;
+        last ; # Refresh
+
+    } elsif ($key eq 'x') {
+        get_gdbm ;
+        print "Warning: You must abort quickly dumping if service is running\n",
+            "Gdbm dump:\n";
+        my ( $i, $l, $line ) = ( 0, 0, 0 ) ;
+        my @list = sort(keys(%gdbm)) ;
+        foreach $key (@list) {
+            my $L = length($key)>30 ? 1 : 0 ;
+            if ($l or $L) {
+                print "\n" ;
+                $i = 0 ;
+                $l = $L ;
+                $line ++ ;
+            }
+
+            # Extract comprehensible value
+            my $value = ref($gdbm{$key}) || $gdbm{$key} ;
+            #$value = ref($value)
+            $value = ref(thaw($value)) if ( $value =~ /\x04/ );
+
+            # Keep value as a 30 chars length string
+            my $text = sprintf(": %-26s| ",substr($value,0,26)) ;
+
+            print sprintf("%30s%s",$key,$text);
+
+            # Avoid to output pres a key message when line=0
+            if ( ++$i % 3 ) {
+                next ;
+
+            } else {
+                print "\n" ;
+                $line ++ ;
+            }
+
+            unless ( $line % 20 ) {
+                print "
+                    [ Press any key to continue but [a] to abort the dump ]" ;
+                system "stty", '-icanon', 'eol', "\001";
+                my $press = lc(getc) ;
+                last if ( $press eq 'a' );
+                print "\n" ;
+                ( $i, $l ) = ( 0, 0 ) ;
+            }
+        }
+        print "\n" ;
+        release_gdbm ;
+
+    } elsif ($key eq 't') {
+        print "Twin status:\n";
+        my ( $twin, $same, $checkcount ) = ( 0, 0, 0 );
+        my %done = () ;
+        my @list = sort(keys(%status)) ;
+        my $listtotal = 0 ;
+        $| = 1 ;
+        foreach my $check (@list) {
+            foreach my $cmp
+            (grep { ! exists($done{'__'.$check.'__'.$_.'__'}) } @list) {
+                # Don't compare on the same key
+                next if ( $check eq $cmp );
+
+                # Don't compare if still compared
+                $done{'__'.$cmp.'__'.$check.'__'} = 1 ;
+
+                if ( $status{$check} eq $status{$cmp} ) {
+                    print "$check and $cmp are twins\n" ;
+                    $twin ++ ;
+
+                } elsif ( $status{$check}->{JOBID} eq $status{$cmp}->{JOBID} ) {
+                    print "$check and $cmp are for the same job, but with ",
+                        $status{$check}->{REV}, " vs ", $status{$cmp}->{REV},
+                        " revision, and ", $status{$check}->{STEP}, ":'",
+                        $status{$check}->step_status($status{$check}->{STEP}),
+                        "' vs ", $status{$cmp}->{STEP}, ":'",
+                        $status{$cmp}->step_status($status{$cmp}->{STEP}),
+                        " step/status\n" ;
+                    $same ++ ;
+                }
+
+                $checkcount ++ ;
+            }
+            print sprintf("%.2f%%  \r", ++$listtotal * 100 / @list );
+        }
+        print "Checks: $checkcount, Twins: $twin, Same job status: $same\n" ;
+
+    } elsif ($key eq 'l') {
+        print "Job keys:\n";
+        my $i = 0 ; my @list = sort(keys(%status)) ;
+        foreach $key (@list) {
+            print sprintf("%30s",$key), ++$i % 5 ? " " : "\n" ;
+        }
+        print "\n" if ($i % 5);
+
+    } elsif ($key eq 'm') {
+        print "Ref keys:\n" ;
+        my $i = 0 ; my @list = sort(keys(%ref)) ;
+        foreach $key (@list) {
+            print sprintf("%20s -> %5s",$key,$ref{$key}),
+                ++$i % 5 ? " | " : "\n" ;
+        }
+        print "\n" if ($i % 5);
+
+    } elsif ($key eq 'a' and $name) {
+        print "$name references:\n" ;
+        my $i = 0 ; my @list = grep {
+            $ref{$_} eq $name or
+            ($ref{$_} =~ /^\d+$/ and $name eq '_SID_'.$ref{$_})
+            } sort(keys(%ref)) ;
+        my $list_count = 0 ; my @chained = () ; # Search for chained refs
+        while ( @list + @chained != $list_count ) {
+            push @chained, @list ;
+            $list_count = @chained ;
+            @list = grep { $key = $ref{$_} ; grep { /^$key$/ } @list
+                } sort(keys(%ref)) ;
+        }
+        foreach $key (@chained) {
+            print sprintf("%40s",$key), ++$i % 5 ? " " : "\n" ;
+        }
+        print "\n" if ($i % 5);
+
+    } elsif ($key eq 'n' or $key eq 'p') {
+        if ( $key eq 'n') {
+            if ($index<0) {
+                $index = 0 ;
+            } elsif (keys(%status)>$index+10) {
+                $index += 10 ;
+            }
+        } elsif ($key eq 'p') {
+            if ($index>10) {
+                $index -= 10 ;
+            } else {
+                $index = 0 ;
+            }
+        }
+
+    } elsif ($key =~ /^\d$/) {
+        $selected = $index+$key ;
+        $status = $status{$status[$selected]} ;
+        $name = $status[$selected] ;
+
+    } elsif ($key eq 's') {
+        get_gdbm ;
+        my $tied = tied(%gdbm) ;
+        $tied->reorganize if (defined($tied) and confirm);
+        release_gdbm ;
+    }
+    } # End while actions
+}
+
+system "stty", 'icanon', 'eol', '^@' ;
Index: /A2P/a2p/e-adresse.pl
===================================================================
--- /A2P/a2p/e-adresse.pl	(revision 3)
+++ /A2P/a2p/e-adresse.pl	(revision 3)
@@ -0,0 +1,375 @@
+#! /usr/bin/perl
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Program to handle service XML structure to send e-mail and return a status
+#
+
+# System libraries
+use strict;
+
+# A2P libraries
+use A2P::EService::Tools qw( try abort get_conf get_id get_lib
+                             get_useragent get_work );
+use A2P::EService::SimpleXML ;
+
+BEGIN {
+    our $REVISION = sprintf "%s", q$Rev: 906 $ =~ /(\d[0-9.]+)\s+/ ;
+}
+our $REVISION ;
+
+# Step 0: Read configuration and load libraries
+my ( $service ) = $0 =~ m|([^/.]+)(\.pl)*$| ;
+
+# Expected lists in configuration
+my @getfromconf = qw( timeout SMTP body attachment From To Cc Bcc ) ;
+
+try "Reading $service rev$REVISION configuration" ;
+my $conf = &get_conf( $service, @getfromconf );
+abort "Configuration not generated" unless ( ref($conf) =~ /^HASH/i );
+
+try "Loading libraries" ;
+map { &get_lib(@{$_}) or abort "$_ not found" } (
+    # Library to use        supported version
+    [ "Net::SMTP"     =>      2.29        ],
+    [ "MIME::Types"   =>      1.17        ],
+    [ "MIME::Lite"    =>      3.01        ],
+    [ "Mail::Address" =>      1.74        ]
+    ) ;
+
+# Step 1: Get pdf file and e-adresse file as job list
+try "Reading job to do" ;
+my @job = &get_work() ;
+
+try "Checking '@job' work to do" ;
+abort unless ( @job == 2 and grep { defined and $_ } @job == 2 );
+
+my ( $pdf, $xmlfile ) = @job ;
+
+# Step 2: Read e-adresse file and verify its format
+try "Loading new $service XML file" ;
+my $xml = new A2P::EService::SimpleXML($xmlfile);
+abort "Bad '$xmlfile' XML file"
+    unless ( defined($xml) and $xml );
+
+my $name = $xml->name ;
+abort "Unexpected '$name' root node for $xmlfile"
+    unless ( $name =~ /^eadresse$/ );
+
+# Read attributs for the mail
+try "Reading mail attributs" ;
+my $xmlid        = $xml->attribut('id') ;
+my $importance   = $xml->attribut('importance')   || 'normal' ;
+my $sensitivity  = $xml->attribut('sensitivity')  || 'normal' ;
+my $notification = $xml->attribut('notification') || 'no'     ;
+my $confirmation = $xml->attribut('confirmation') || 'none'   ;
+
+# Read recipients
+try "Reading mail recipients" ;
+my @from = $xml->nodes( 'rcpt', { type => qr/^from$/ }, 'name' );
+my @to   = $xml->nodes( 'rcpt', { type => qr/^to|$/  }, 'name' );
+my @cc   = $xml->nodes( 'rcpt', { type => qr/^cc$/   }, 'name' );
+my @bcc  = $xml->nodes( 'rcpt', { type => qr/^bcc$/  }, 'name' );
+
+# Basic checks on recipients
+try "Checking From recipient" ;
+abort "Only one From recipient supported" unless ( @from < 2 );
+abort "No From recipient found" unless @from ;
+try "Checking To recipients" ;
+abort "No To recipient found" unless @to ;
+
+# Recomposition
+foreach my $key (qw(From To Cc Bcc)) {
+    my $keyconf = $conf->{$key} ;
+    next unless (defined($keyconf) and ref($keyconf) =~ /^HASH/i);
+    next unless (defined($keyconf->{active}) and $keyconf->{active});
+
+    my @address = grep { defined }
+        ( $keyconf->{address}, { name => $keyconf->{name} } );
+
+    abort "Bad $key reconfiguration with '@address'"
+        unless ( @address == 2 );
+
+    $keyconf->{replace} = 1 if ( $key eq 'From' );
+
+    if (defined($keyconf->{replace}) and $keyconf->{replace}) {
+        eval '@' . lc($key) . ' = ( \@address )' ;
+
+    } else {
+        eval 'push @' . lc($key) . ', \@address' ;
+    }
+}
+
+# Sub to recompose recipient in RFC standard
+sub recipient {
+    return $_[0] unless ( ref($_[0]) =~ /^ARRAY/i );
+    my ( $content, $attributs ) = @{$_[0]} ;
+    my $name = exists($attributs->{name}) ? $attributs->{name} : "" ;
+    return $content unless ($name);
+    my $address = new Mail::Address( $name, $content) ;
+    return $address->format ;
+}
+
+# Advanced check of recipients
+try "Scanning recipients" ;
+@from = map { &recipient($_) } @from ;
+@to   = map { &recipient($_) } @to   ;
+@cc   = map { &recipient($_) } @cc   ;
+@bcc  = map { &recipient($_) } @bcc  ;
+
+# Read subject and text of the mail
+try "Getting subject" ;
+my @subject = $xml->nodes( 'subject' );
+
+try "Checking subject" ;
+abort "Only one subject supported" unless ( @subject < 2 );
+abort "No subject found" unless @subject ;
+
+# Extract the subject
+my ( $subject ) = @subject ;
+chomp $subject ;
+abort "Subject must not contain line feed" if ( $subject =~ /\n/ms );
+
+# This last call must be done after nodes calls to avoid getting the content of
+# nodes in the body.
+try "Getting mail body" ;
+my @body = $xml->nodes( 'body' );
+
+try "Checking mail body" ;
+abort "Only one body node supported" unless ( @body < 2 );
+abort "No body found" unless @body ;
+my ( $body ) = @body ;
+
+# Set unique id for this mail and user-agent
+my $mailid     = &get_id( $xmlid ) ;
+my $user_agent = &get_useragent() ;
+
+# Step 3: Prepare the mail and attach the PDF to the mail
+try "Preparing the mail" ;
+
+# Legal values
+my %supported = (
+    Disposition => {'inline' => 1, 'attachment' => 1},
+    Type => {'multipart/mixed' => 1 , 'text/plain' => 1,
+        'application/pdf' => 1},
+    Encoding => {'7bit' => 1, '8bit' => 1, 'quoted-printable' => 0,
+        'base64' => 1},
+    Charset => {'iso-8859-1' => 1, 'UTF-8' => 1},
+    Importance => {'low' => 1, 'normal' => 1, 'high'=> 1},
+    Sensitivity => {'normal' => 1, 'confidential' => 'Company-Confidential',
+        'private' => 'Private', 'personal' => 'Personal'},
+    Notification => {'no' => 1, 'yes' => 1},
+    Confirmation => { 'no' => 1, 'none' => 1, 'yes' => 1 }
+    );
+
+# Preparing headers
+my ( $from ) = @from;
+
+my $mail = MIME::Lite -> new (
+    From          => $from,
+    To            => \@to,
+    Cc            => \@cc,
+    Bcc           => \@bcc,
+    Subject       => $subject,
+    Type          => 'multipart/mixed',
+    'Message-ID'  => $mailid,
+    'User-Agent:' => $user_agent,
+    'Return-Path' => $from
+    );
+
+# Preparing optionnal headers
+abort "Bad xml attribute importance: $importance"
+    unless(exists($supported{Importance} -> {$importance}) and
+    $supported{Importance} -> {$importance});
+$mail -> add('Importance' => $importance)
+    unless($importance eq 'normal');
+
+abort "Bad xml attribute sensitivity: $sensitivity"
+    unless(exists($supported{Sensitivity} -> {$sensitivity}) and
+    $supported{Sensitivity} -> {$sensitivity});
+$mail -> add('Sensitivity' => $supported{Sensitivity} -> {$sensitivity})
+    unless($sensitivity eq 'normal');
+
+abort "Bad xml attribute notification: $notification"
+    unless(exists($supported{Notification} -> {$notification}) and
+    $supported{Notification} -> {$notification});
+$mail -> add('Return-Receipt-To' => $from)
+    unless($notification eq 'no');
+
+abort "Bad xml attribute confirmation: $confirmation"
+    unless(exists($supported{Confirmation} -> {$confirmation}) and
+    $supported{Confirmation} -> {$confirmation});
+$mail -> add('Disposition-Notification-To' => $from)
+    unless($confirmation eq 'no' or $confirmation eq 'none');
+
+# Preparing and attach body message
+my $attr = $conf -> {body};
+
+my $dispo = defined($attr -> {disposition})?
+                $attr -> {disposition}:'inline';
+abort "Bad conf for mail disposition: $dispo"
+    unless(exists($supported{Disposition} -> {$dispo}) and
+    $supported{Disposition} -> {$dispo});
+my $type = defined($attr -> {type})?$attr -> {type}:'TEXT';
+abort "Bad conf for mail type: $type"
+    unless(exists($supported{Type} -> {$type}) and
+    $supported{Type} -> {$type});
+my $encoding = defined($attr -> {encoding})?
+    $attr -> {encoding}:'8bit';
+abort "Bad conf for mail encoding: $encoding"
+    unless(exists($supported{Encoding} -> {$encoding}) and
+    $supported{Encoding} -> {$encoding});
+my $charset = defined($attr -> {charset})?
+    $attr -> {charset}:'iso-8859-1';
+abort "Bad conf for mail charset: $charset"
+    unless(exists($supported{Charset} -> {$charset}) and
+    $supported{Charset} -> {$charset});
+
+my $msg = MIME::Lite -> new (
+    Disposition => $dispo,
+    Type        => $type,
+    Encoding    => $encoding,
+    Data        => $body,
+    );
+$msg -> attr('content-type.charset' => $charset);
+$mail -> attach($msg);
+
+# Attach the PDF
+my ( $filename ) = $pdf =~ m|([^/]*)$|;
+my $attachment = $conf -> {attachment};
+
+unless (defined($attachment->{skip}) and $attachment->{skip}) {
+    $dispo = defined($attachment -> {disposition})?
+                    $attachment -> {disposition}:'inline';
+    abort "Bad conf for attachment disposition: $dispo"
+        unless(exists($supported{Disposition} -> {$dispo}) and
+        $supported{Disposition} -> {$dispo});
+    $type = defined($attachment -> {type})?
+        $attachment -> {type}:'application/pdf';
+    abort "Bad conf for attachment type: $type"
+        unless(exists($supported{Type} -> {$type}) and
+        $supported{Type} -> {$type});
+    $encoding = defined($attachment -> {encoding})?
+        $attachment -> {encoding}:'base64';
+    abort "Bad conf for attachment encoding: $encoding"
+        unless(exists($supported{Encoding} -> {$encoding}) and
+        $supported{Encoding} -> {$encoding});
+
+    # By default, we are trying to extract name from subject using
+    # eventually a regex an sprintf template from configuration
+    my $pdfname_re = qr/:\s+([^#]+)\s+#\s+([^#]+)\s+#\s+([^#]+)\s+#/ ;
+    my $pdfname_printf = '%s-%s-%s.pdf' ;
+    if (!defined($attachment -> {name})
+    or $attachment -> {name} =~ /^from subject$/i) {
+        # Get regexp from conf if available
+        $pdfname_re = $attachment -> {name_re}
+            if (defined($attachment -> {name_re})
+            and ref($attachment -> {name_re}) =~ /^Regexp/i);
+
+        # Get template name if available
+        $pdfname_printf = $attachment -> {name_printf}
+            if (defined($attachment -> {name_printf})
+            and $attachment -> {name_printf} );
+
+        my @elements = $subject =~ $pdfname_re ;
+        $filename = sprintf( $pdfname_printf, @elements );
+        abort "Can't compute valid pdfname from '@elements' and $pdfname_printf"
+            unless ( $filename and $filename =~ /^.+\.pdf$/i );
+    }
+
+    $mail -> attach (
+        Disposition => $dispo,
+        Type        => $type,
+        Encoding    => $encoding,
+        Path        => $pdf,
+        Filename    => $filename,
+        );
+}
+
+# Step 4: Send the mail
+try "Send the mail" ;
+
+$! = 0;
+my $SMTP = $conf->{SMTP} ;
+my %supported_smtp = (
+    'smtp'      => 1 ,
+    'sub'       => 1 ,
+    'sendmail'  => 1
+    );
+
+abort "No server defined"
+    unless ( defined($conf -> {SMTP}) and $conf -> {SMTP} );
+
+our $host = "" ;
+my $sent = 0 ;
+
+my @send_errors = () ;
+$SIG{__DIE__} = sub {
+        my ( $mesg ) = "@_" =~ /^(.*) at \(eval.*$/ms ;
+        push @send_errors, $host . ": $mesg" ;
+    } ;
+
+# Check also the order
+my @types = grep { exists($supported_smtp{$_}) and $supported_smtp{$_} }
+    keys %{$SMTP} ;
+abort "No supported type in configuration" unless @types ;
+
+if (exists($SMTP->{order})) {
+    my @order = @{$SMTP->{order}} ;
+    my @newlist = () ;
+    while (@order) {
+        my $next = shift @order ;
+        push @newlist, $next if ( grep { /^$next$/ } @types );
+    }
+    # Check we still have the same number of types
+    abort "Bad order list in configuration" unless ( @newlist == @types );
+    @types = @newlist ;
+}
+
+foreach my $type ( @types ) {
+
+    my $server = $SMTP -> {$type};
+    foreach $host (keys %{$server}) {
+        if ($type eq 'smtp') {
+            my $port = $server -> {$host} || 25 ;
+            $sent ++ and last
+                if eval '$mail->send($type, $host, Port => $port)' ;
+
+        } elsif ($type eq 'sendmail') {
+            my @args = @{$server -> {$host}} ;
+            $sent ++ and last
+                if eval '$mail->send($type, @args)' ;
+
+        } elsif ($type eq 'sub') {
+            my $sub = $server -> {$host} ;
+            $sent ++ and last
+                if eval '$mail->send($type, $sub, $host)' ;
+        }
+    }
+
+    last if $sent ;
+}
+
+abort "@send_errors" unless $sent ;
+
+# Step 5: Report status
+
+exit(0);
Index: /A2P/a2p/test/A2P/Defaults.pm
===================================================================
--- /A2P/a2p/test/A2P/Defaults.pm	(revision 3)
+++ /A2P/a2p/test/A2P/Defaults.pm	(revision 3)
@@ -0,0 +1,46 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+use A2P::Globals ;
+
+sub info {
+    print map { "# $_\n" } @_ ;
+}
+
+our $tie_file = "/tmp/test_tie_status.gdbm" ;
+
+our $test_string = '__TEST__'.$$ ;
+
+our $freezed = qr/^\x04(\x06|\x07)\x081234(5678)*\x04(\x04|\x08){2}\x08../ ;
+
+our $SERVICE_TMP = '/tmp' ;
+our $AFPSPOOL    = '/tmp/afpspool-test' ;
+our $SHMDIR      = '/dev/shm/.test' ;
+system "rm -rf $SHMDIR" if ( -d $SHMDIR and $SHMDIR =~ /shm/ ) ;
+mkdir $SHMDIR ;
+
+our $ADVANCED_DEBUGGING = 1 ;
+our $LOCKID      = 'TEST' ;
+our $LOGFILENAME = '/tmp/a2p-debug.log' ;
+our $DEBUG_IN_FILE = 1 ;
+
+1 ;
Index: /A2P/a2p/test/A2P/JobStatus.pm
===================================================================
--- /A2P/a2p/test/A2P/JobStatus.pm	(revision 3)
+++ /A2P/a2p/test/A2P/JobStatus.pm	(revision 3)
@@ -0,0 +1,327 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+use strict ;
+use Test ;
+use GDBM_File ;
+use Storable qw( freeze );
+
+require 'test/A2P/Defaults.pm' ;
+
+BEGIN {
+    plan
+        tests  => 89 ,
+        onfail => sub { exit(1) }
+}
+
+$| = 1 ;
+
+my %s = () ;
+my %h = () ;
+my %o = () ;
+
+our %STATS ;
+our ( $freezed, $SERVICE_TMP, $SHMDIR, $ADVANCED_DEBUGGING, $LOCKID,
+    $LOGFILENAME, $DEBUG_IN_FILE );
+our $Progname = 'TEST-JobStatus' ;
+
+&info("Loading A2P::JobStatus library");
+ok require A2P::JobStatus ;
+
+sub dbm_base    ; *dbm_base = \&A2P::JobStatus::dbm_base ;
+sub dbm_lock    ; *dbm_lock = \&A2P::JobStatus::dbm_lock ;
+sub dbm_unlock  ; *dbm_unlock = \&A2P::JobStatus::dbm_unlock ;
+sub is_status   ; *is_status = \&A2P::JobStatus::is_status ;
+sub is_tied_status   ; *is_tied_status = \&A2P::JobStatus::is_tied_status ;
+sub cansavetied ; *cansavetied = \&A2P::JobStatus::cansavetied ;
+sub tied_update_status ; *tied_update_status = \&A2P::JobStatus::tied_update_status ;
+sub tie_status_hash ; *tie_status_hash = \&A2P::JobStatus::tie_status_hash ;
+sub get_tied_ref ; *get_tied_ref = \&A2P::JobStatus::_get_tied_ref ;
+sub get_cache_ref ; *get_cache_ref = \&A2P::JobStatus::_get_cache_ref ;
+sub sync_dbm_to_db  ; *sync_dbm_to_db = \&A2P::JobStatus::sync_dbm_to_db ;
+sub not_tied    ; *not_tied = \&A2P::JobStatus::_not_tied ;
+sub not_tied    ; *not_tied = \&A2P::JobStatus::_not_tied ;
+sub cache_cleaner ; *cache_cleaner  = \&A2P::JobStatus::cache_cleaner ;
+sub sync_list   ; *sync_list = \&A2P::JobStatus::sync_list ;
+sub sync_list_inject_again   ; *sync_list_inject_again = \&A2P::JobStatus::sync_list_inject_again ;
+
+&info("Check some facility");
+    ok defined($SERVICE_TMP);
+    ok defined($SHMDIR);
+    ok defined(&dbm_base) ;
+    ok &dbm_base =~ /jobstatus-/ ;
+    ok &dbm_base , '/dev/shm/.test/.jobstatus-' ;
+    ok defined(&cansavetied) ;
+
+&info("Check A2P::Status usability");
+    ok require A2P::Status ;
+        $h{cached} = {} ;
+        $s{status} = new A2P::Status($h{cached},{},'test') ;
+    ok defined($s{status}) and ref($s{status}) =~ /^A2P::Status$/ ;
+    ok &is_status($s{status}) ;
+    ok ! &is_status(undef) ;
+    ok ! &is_status('test') ;
+    ok ! &is_status({}) ;
+    ok ! &is_status('test',{}) ;
+    ok ! &is_status('_test_',$h{cached}) ;
+    ok $s{stored} = &freeze($s{status}) ;
+    ok ! &is_tied_status('_SID_100_rev','UNIT-TEST') ;
+
+&info("Test locking");
+    $s{file} = &dbm_base . $LOCKID ;
+    ok $s{file} , '/dev/shm/.test/.jobstatus-'.$LOCKID ;
+    system "touch $s{file}" ;
+    ok &dbm_lock($s{file}) ;
+    ok -e $s{file}.'.LCK' ;
+    my $lck = qx(/usr/sbin/lsof -l $s{file}.LCK  2>&1 | tee $s{file}.LCK 2>&1) ;
+    &info("Check lsof result:", $lck, "toward: perl $$ $< [0-9]+wW REG [0-9,]+ 0");
+    ok $lck && $lck =~ /perl\s+$$\s+$<\s+\d+[wu]W\s+REG\s+[0-9,]+\s+0\s+/ ;
+    ok &dbm_unlock ;
+    &info("Locking file should not be removed as it could be shared");
+    ok -e $s{file}.'.LCK' ;
+    ok ! qx(/usr/sbin/lsof $s{file}.LCK) ;
+
+    &info("Check son can't access locked file");
+    ok &dbm_lock($s{file}) ;
+    my $pid = fork ;
+    unless ($pid) {
+        $0 = 'son_trying_to_lock' ;
+        &info("In $0...");
+        $SIG{ALRM} = sub { &info("$0: 5s timeout reached") ; exit(1) };
+        alarm 5 ;
+        my $ret = &dbm_lock($s{file});
+        &info("$0: Locking returned $ret");
+        exit(10 + $ret);
+    }
+    ok waitpid($pid,0), $pid ;
+    my $ret = $? ;
+    ok defined($pid);
+    &info("Check son returns without error");
+    ok $ret, 2560 ;
+    ok $ret - 2816 ;
+
+&info("Check we can tie the status hash");
+    unlink $s{file} ;
+    ok ! -e $s{file} ;
+    $h{Tie} = &tie_status_hash($LOCKID);
+    ok defined($h{Tie});
+    ok ref($h{Tie}), "GDBM_File" ;
+    ok &not_tied , 0 ;
+    ok -e $s{file} ;
+    &info("Check we have write access to tie");
+    ok &cansavetied , 1 ;
+    delete $h{Tie} ;
+    untie %{&get_tied_ref} ;
+    ok &dbm_unlock ;
+
+    &info("Check we can tie in read mode");
+    $h{Tie} = &tie_status_hash($LOCKID, 0);
+    ok defined($h{Tie});
+    ok ref($h{Tie}), "GDBM_File" ;
+    ok &not_tied , 0 ;
+    ok -e $s{file} ;
+    &info("Check we don't have write access to tie");
+    ok &cansavetied , 0 ;
+    delete $h{Tie} ;
+    untie %{&get_tied_ref} ;
+    ok &dbm_unlock ;
+
+sub get_file_tied {
+    $h{FileTied} = &tie_status_hash($LOCKID);
+    $h{TiedRef} = &get_tied_ref ;
+    return 0 unless (defined($h{TiedRef}));
+    return 1 unless (defined($h{FileTied}));
+    return 2 unless (tied(%{$h{TiedRef}}) == $h{FileTied});
+    delete $h{TiedRef} ;
+    return &cansavetied ? &get_tied_ref : 3 ;
+}
+
+sub release_file {
+    delete $h{FileTied} ;
+    untie %{&get_tied_ref};
+    &dbm_unlock ;
+}
+
+sub delete_file {
+    my $lockid = @_ ? shift : $LOCKID ;
+    unlink &dbm_base.$lockid ;
+    unlink &dbm_base.$lockid.'.LCK' ;
+}
+
+sub dump_hash {
+    $h{This} = &get_cache_ref ;
+    map { print STDERR "CACHE: $_ -> ".$h{This}->{$_},($h{This}->{$_}=~/^HASH/?
+        " -> (".keys(%{$h{This}->{$_}})." keys)":""),"\n" }
+        sort(keys(%{$h{This}})) ;
+    map { print STDERR "CACHE: __SID__ -> $_ -> ".$h{This}->{__SID__}->{$_},"\n"
+        } sort(keys(%{$h{This}->{__SID__}})) ;
+    $h{This} = &get_tied_ref ;
+    map { print STDERR "TIED : $_ -> ", ( $h{This}->{$_} =~ $freezed ?
+        "Freezed storable object" : $h{This}->{$_}),"\n" }
+        sort(keys(%{$h{This}})) ;
+    delete $h{This} ;
+}
+
+sub purge_hash {
+    $h{This} = shift ;
+    map { delete $h{$h{This}}->{$_} } keys(%{$h{$h{This}}}) ;
+    delete $h{$h{This}} ;
+    delete $h{This} ;
+}
+
+# clean
+&delete_file ;
+unlink $s{file} ;
+unlink $s{file} . '.LCK' ;
+
+&info("Check tied_update_status API without DB connection");
+    ok &tied_update_status('UNIT-TEST',5,'#');
+        &get_file_tied ;
+    ok $h{Ref} = &get_tied_ref ;
+    ok $h{Ref} =~ /^HASH/ ;
+    ok $h{cache} = &get_cache_ref ;
+    ok $h{cache} =~ /^HASH/ ;
+        #&dump_hash ;
+    ok $h{cache}->{'UNIT-TEST'} ;
+        $o{test} = $h{cache}->{'UNIT-TEST'} ;
+        $s{sid}  = $o{test}->get_sid_index ;
+    &info("SID should be AFPNAME by default");
+    ok $s{sid}, 0 ;
+    ok $h{cache}->{'__SID__'} ;
+    &info("Should not be in SID cache");
+    ok $h{cache}->{'__SID__'}->{$s{sid}}, undef ;
+    ok $h{Ref}->{$o{test}->get_sid_key} ;
+    ok $h{Ref}->{$o{test}->get_sid_version_key} ;
+# Status: tied = 2, cached = 3
+    ok keys(%{$h{Ref}}), 2 ;
+    ok keys(%{$h{cache}}), 3 ;
+    &info("SID $s{sid} at revision 1");
+    ok $o{test}->is_older_than_tied, 0 ;
+        $o{test}->{REV} = 0 ; # Artificialy make object older
+    ok $o{test}->is_older_than_tied, 1 ;
+        #&dump_hash ;
+        delete $h{cache} ;
+        &release_file ;
+
+    &info("Try status update");
+        &info("First call set the real JOBID name");
+    &tied_update_status('UNIT-TEST',5,'#',{ JOBID => 'JOBID-NAME' });
+    &info("SID $s{sid} at revision 2");
+    &tied_update_status('UNIT-TEST',5,'#',{JID => 'JOBID-NAME',STATUS=>'OK'});
+    &info("SID $s{sid} at revision 3");
+        &get_file_tied ;
+    ok $h{Ref} = &get_tied_ref ;
+    ok $h{Ref}->{'JOBID-NAME'}, 'UNIT-TEST' ;
+        #&dump_hash ;
+        delete $h{Ref} ;
+        &release_file ;
+
+&info("Check we retrieve the previous status from cache");
+    ok $h{cache} = &get_cache_ref ;
+    ok defined($h{cache}->{'UNIT-TEST'}) ;
+    ok $h{cache}->{'UNIT-TEST'}, $h{cache}->{'JOBID-NAME'} ;
+        $o{test} = $h{cache}->{'UNIT-TEST'} ;
+    ok $o{test}->get_sid_index , 0 ;
+    ok $o{test}->{JOBID}, 'JOBID-NAME' ;
+    ok $o{test}->{AFP}, 'UNIT-TEST' ;
+    ok $o{test}->is_job , 'JOBID-NAME' ;
+    ok ! defined($h{cache}->{'__SID__'}->{$s{sid}}) ;
+        &purge_hash('cache');
+
+&release_file ;
+&delete_file ;
+
+sub populate_tie {
+    my $count = shift ;
+        &release_file ;
+    ok &not_tied, 1 ;
+    ok $h{cached} = &get_cache_ref ;
+    ok $h{'tied'} = &get_tied_ref ;
+        &get_file_tied ;
+    ok &not_tied, 0 ;
+        my $index = 1 ;
+        while ($index <= $count) {
+            my $test = sprintf('test-%s-%06d',$LOCKID,$index);
+            $s{status} = new A2P::Status($h{cached},$h{'tied'},$test) ;
+            $s{status}->save_tied ;
+            $index ++ ;
+        } ;
+        delete $s{status} ;
+}
+
+&info("Check sync_cache_with_gdbm");
+        $LOCKID = 'TEST-1' ;
+    ok $h{cached} = &get_cache_ref ;
+    ok $h{'tied'} = &get_tied_ref ;
+# Status: tied = 0, cached = 0
+    ok keys(%{$h{'tied'}}), 0 ;
+    ok keys(%{$h{cached}}), 0 ;
+        #&dump_hash ;
+
+        &info("Create 6 status for $LOCKID");
+        &populate_tie(6);
+# Status: tied = 6*2, cached = 6+2
+    ok keys(%{$h{'tied'}}), 12 ;
+    ok keys(%{$h{cached}}), 8 ; # with __SID__ index and __GDBM_WRITER__
+    ok defined($h{cached}->{'__SID__'}) ;
+    ok defined($h{cached}->{'__GDBM_WRITER__'}) ;
+    ok keys(%{$h{cached}->{'__SID__'}}), 0 ;
+        #&dump_hash ;
+
+        $LOCKID = 'TEST-2' ;
+        &info("Create 10 other status for $LOCKID");
+        &populate_tie(10);
+# Status: tied = 10*2, cached = 6+10+2
+    ok keys(%{$h{'tied'}}), 20 ;
+    ok keys(%{$h{cached}}), 18 ; # with __SID__ index and __GDBM_WRITER__
+        #&dump_hash ;
+
+        &info("Remove status from cache");
+        map {
+            $h{cached}->{$_}->remove_from_cache ;
+        } grep { $_ !~ /^__/ } keys(%{$h{cached}}) ;
+# Status: tied = 10*2, cached = 2
+    ok keys(%{$h{'tied'}}), 20 ;
+    ok keys(%{$h{cached}}), 2 ; # with __SID__ index and __GDBM_WRITER__
+    ok keys(%{$h{cached}->{'__SID__'}}), 0 ;
+        &release_file ;
+    ok &not_tied, 1 ;
+# Status: tied = 0, cached = 1
+    ok keys(%{$h{'tied'}}), 0 ;
+    ok keys(%{$h{cached}}), 1 ; # with only __SID__ index
+    ok keys(%{$h{cached}->{'__SID__'}}), 0 ;
+        &dump_hash ;
+
+&release_file ;
+
+    &info("Internal statistics:") if (keys(%STATS));
+    map { &info(" $_: $STATS{$_}") } grep { exists($STATS{$_}) } qw(
+        CACHED-STATUS-OBJECT-KEPT CACHED-STATUS-OBJECT-CLEANED
+        STATUS-OBJECT-KEPT-IN-CACHE  STATUS-OBJECT-KEPT-IN-CACHE-MAX
+        CACHED-STATUS-OBJECT-CHECKED CACHED-STATUS-OBJECT-CHECKED-MAX
+        STATUS-OBJECT-EARLY-CLEANED CACHE-KEYS-COUNT CACHE-KEYS-COUNT
+        TIMING-SYNC-CACHE-API NO-SYNC-NEEDED-TEST-1 LOCKIDS-CHECK-CALL
+        LOCKIDS-CHECK-LISTS-NOT-EMPTY TEST-1-TIE-UPDATED
+        SYNC-LIST-REPOPULATE-TEST-1
+    );
+
+1 ;
Index: /A2P/a2p/test/A2P/SpoolManager.pm
===================================================================
--- /A2P/a2p/test/A2P/SpoolManager.pm	(revision 3)
+++ /A2P/a2p/test/A2P/SpoolManager.pm	(revision 3)
@@ -0,0 +1,113 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+use strict ;
+use Test ;
+
+require 'test/A2P/Defaults.pm' ;
+
+BEGIN {
+    plan
+        tests  => 30 ,
+        onfail => sub { exit(1) }
+}
+
+$| = 1 ;
+
+our $tie_file ;
+our $test_string ;
+
+our ( $SERVICE_TMP, $SHMDIR, $ADVANCED_DEBUGGING, $LOCKID,
+    $LOGFILENAME, $DEBUG_IN_FILE, $AFPSPOOL );
+our $Progname    = 'TEST-SpoolManager' ;
+
+# Be sure
+unlink $AFPSPOOL unless -d $AFPSPOOL ;
+mkdir $AFPSPOOL unless -d $AFPSPOOL ;
+mkdir $AFPSPOOL.'/.a2p' unless -d $AFPSPOOL.'/.a2p' ;
+
+&info("Loading A2P::SpoolManager library");
+ok require A2P::SpoolManager ;
+
+sub update_prefix ; *update_prefix = \&A2P::SpoolManager::update_prefix ;
+
+&info("Update prefix");
+# Default for $SPOOL_PREFIX is "TRANS ARCHI" ;
+ok join('-',&update_prefix("TRANS ARCHI")), "TRANS-ARCHI" ; #2
+
+sub prefix ; *prefix = \&A2P::SpoolManager::prefix ;
+
+&info("Check file match a prefix");
+ok &prefix("TRANS.TEST"), "TRANS" ;
+ok &prefix("TrANs.TEST"), "TrANs" ;
+ok &prefix("ARCHI.A"), "ARCHI" ;
+ok &prefix("archi."), "" ;
+ok &prefix("TEST"), "" ;
+ok &prefix(""), "" ;
+ok &prefix("none"), "" ;
+ok &prefix("none.TEST.none"), "" ; #10
+
+
+&info("Check get locking");
+
+
+sub openLockingPrefix ;  *openLockingPrefix = \&A2P::SpoolManager::openLockingPrefix ;
+sub lockprefix ;         *lockprefix = \&A2P::SpoolManager::lockprefix ;
+sub unlockprefix ;       *unlockprefix = \&A2P::SpoolManager::unlockprefix ;
+sub closeLockingPrefix ; *closeLockingPrefix = \&A2P::SpoolManager::closeLockingPrefix ;
+
+&info("Check locking on prefix");
+my $hashref = { LockingPrefix => {} };
+my $lockfile = $AFPSPOOL . '/.a2p/TRANS.LCK' ;
+unlink $lockfile ;
+ok ! -e $lockfile ;
+ok &openLockingPrefix($hashref), 1 ;
+ok -e $lockfile ;
+ok exists($hashref->{LockingPrefix}->{TRANS}) ; #14
+ok exists($hashref->{LockingPrefix}->{ARCHI}) ;
+my $TRANS = $hashref->{LockingPrefix}->{TRANS} ;
+my $ARCHI = $hashref->{LockingPrefix}->{ARCHI} ;
+ok (defined($TRANS) and defined($ARCHI));
+ok ref($TRANS), 'GLOB' ;
+ok ref($ARCHI), 'GLOB' ;
+ok &lockprefix($hashref,"TRANS") ; #19
+my $lck = qx(/usr/sbin/lsof -l $lockfile  2>&1 | tee /tmp/test-locking.log 2>&1) ;
+&info("Check lsof result:", $lck, "toward: perl $$ $< [0-9]+wW REG [0-9,]+ 0");
+ok $lck && $lck =~ /perl\s+$$\s+$<\s+\d+wW\s+REG\s+[0-9,]+\s+0\s+/ ;
+ok &unlockprefix($hashref,"TRANS") , 1 ;
+ok exists($hashref->{LockingPrefix}->{TRANS}) ; #22
+ok exists($hashref->{LockingPrefix}->{ARCHI}) ;
+ok &closeLockingPrefix($hashref), 1 ;
+ok ! exists($hashref->{LockingPrefix}->{TRANS}) ;
+ok ! exists($hashref->{LockingPrefix}->{ARCHI}) ; #26
+
+&info("Checklocking when lock file has been deleted");
+&openLockingPrefix($hashref) ;
+unlink $lockfile ;
+ok &lockprefix($hashref,"TRANS") ; #27
+$lck = qx(/usr/sbin/lsof -l $lockfile  2>&1 | tee /tmp/test-locking.log 2>&1) ;
+&info("Check lsof result:", $lck, "toward: perl $$ $< [0-9]+wW REG [0-9,]+ 0");
+ok $lck && $lck =~ /perl\s+$$\s+$<\s+\d+wW\s+REG\s+[0-9,]+\s+0\s+/ ;
+ok &unlockprefix($hashref,"TRANS") , 1 ; #29
+ok &closeLockingPrefix($hashref), 1 ;
+
+1 ;
Index: /A2P/a2p/test/A2P/Status.pm
===================================================================
--- /A2P/a2p/test/A2P/Status.pm	(revision 3)
+++ /A2P/a2p/test/A2P/Status.pm	(revision 3)
@@ -0,0 +1,556 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+use strict;
+use Test;
+use GDBM_File;
+use Storable qw( thaw );
+
+require 'test/A2P/Defaults.pm' ;
+
+use warnings FATAL => qw(void);
+
+BEGIN {
+    plan
+        tests  => 215,
+        onfail => sub { exit(1) }
+}
+
+$| = 1 ;
+
+our $tie_file ;
+our $test_string ;
+our ( $freezed, $SERVICE_TMP, $SHMDIR, $ADVANCED_DEBUGGING, $LOCKID,
+    $LOGFILENAME, $DEBUG_IN_FILE, %STATS );
+our $Progname    = 'TEST-Status' ;
+
+unlink $tie_file ;
+
+&info("Loading A2P::Status library");
+    ok require A2P::Status ;
+
+&info("Check default A2P::Status table");
+    ok join("*",&A2P::Status::INTIAL_STATUS), 'o*_*_*0*0*0*0*0*0*0*0*_*_' ;
+
+my $status ;
+my $cache_hashref   = {} ;
+my $cache_hashref_2 = {} ;
+my %tied__hash      = () ;
+
+my %h = () ;
+my %s = () ;
+my $do_next_test = 1 ;
+
+sub dump_hash {
+    $h{This} = $cache_hashref ;
+    map { print STDERR "CACHE: $_ -> ".$h{This}->{$_},($h{This}->{$_}=~/^HASH/?
+        " -> (".keys(%{$h{This}->{$_}})." keys)":""),"\n" }
+        keys(%{$h{This}}) ;
+    map { print STDERR "CACHE: __SID__ -> $_ -> ".$h{This}->{__SID__}->{$_},"\n"
+        } keys(%{$h{This}->{__SID__}}) ;
+    $h{This} = \%tied__hash ;
+    map { print STDERR "TIED : $_ -> ", ( $h{This}->{$_} =~ $freezed ?
+        "Freezed storable object" : $h{This}->{$_}),"\n" }
+        keys(%{$h{This}}) ;
+    delete $h{This} ;
+}
+
+
+&info("Get a status object");
+    $status = new A2P::Status( $cache_hashref, \%tied__hash );
+    ok defined($status) ;
+    ok ref($status) , 'A2P::Status' ;
+
+&info("Check cache");
+    ok $cache_hashref->{'noname'} , $status ;
+    ok keys(%{$cache_hashref}) , 2 ;
+
+sub check_status_defaults {
+    #&dump_hash ;
+    my $self = shift ;
+    my $job  = shift ;
+    &info("Checking Status object defaults of " . $job );
+    ok $self->{JOB}, $job ;
+    ok $self->is_job, $job ;
+    ok $self->{LOCKID}, $LOCKID ;
+    ok $self->{DAY}, 19700101 ;
+    &info("Checked");
+}
+
+&check_status_defaults($status,'noname');
+    ok $status->{AFP}, 'noname' ;
+    ok $status->get_sid_index, 0 ;
+
+&info("Insert status in cache");
+    ok $status->is_job('test'), 'test' ;
+    ok $status->cached ;
+
+&info("Check cache");
+    ok $cache_hashref->{'test'} , $status ;
+    ok keys(%{$cache_hashref}) , 3 ;
+    #&dump_hash ;
+    delete $cache_hashref->{'noname'} ;
+    delete $cache_hashref->{'test'} ;
+
+
+&info("Try tied cache");
+    ok defined(tie( %tied__hash, 'GDBM_File', $tie_file, GDBM_WRCREAT, 0660)) ;
+    $cache_hashref->{__GDBM_WRITER__} = 1 ;
+
+&info("Insert status in tied hash");
+    $status = new A2P::Status( $cache_hashref, \%tied__hash, 'TEST-UNIT-1' );
+    ok $cache_hashref->{'TEST-UNIT-1'} , $status ;
+&check_status_defaults($status,'TEST-UNIT-1');
+    ok $status->{AFP}, 'TEST-UNIT-1' ;
+    ok $status->get_sid_index, 0 ;
+
+
+&info("Set jobname, a private scalar and save to tied hash");
+    ok $status->is_job('TEST-UNIT-2') ;
+    ok $status->cached ;
+    ok $status->{"TESTUNIT-$$"} = '__PRIVATE__' ;
+    ok $status->{"TESTUNIT-$$"} , '__PRIVATE__' ;
+&info("Control 'is_tied' returns the same reference avec being tied");
+    ok $status->is_tied, 0 ; # Null when not in tied hash
+    ok $status->save_tied ;
+&info("Status ref is different as re-read from tied hash");
+    my $tied = $status->is_tied ;
+    ok $tied != $status ;
+    ok ref($status) , 'A2P::Status' ;
+    ok ref($tied) , 'A2P::Status' ;
+    ok $status->get_sid_index, $tied->get_sid_index ;
+    ok $cache_hashref->{'TEST-UNIT-2'} , $status ;
+    ok $cache_hashref->{'TEST-UNIT-2'} != $tied ;
+&info("Close tie");
+    untie %tied__hash ;
+
+&info("Reopen as reader and get one in tied hash");
+    ok defined(tie( %tied__hash, 'GDBM_File', $tie_file, GDBM_READER, 0660)) ;
+    $cache_hashref->{__GDBM_WRITER__} = 0 ;
+
+    ok defined($tied__hash{'TEST-UNIT-2'}) ;
+    my $intied = new A2P::Status( $cache_hashref, \%tied__hash, 'TEST-UNIT-2' );
+&info("Check status is inserted in cache automatically");
+    ok defined($intied) and ref($intied) =~ /^A2P::Status$/ ;
+    ok defined($cache_hashref->{'TEST-UNIT-2'}) ;
+    #&dump_hash ;
+
+&info("Control the retrieved jobname");
+    ok defined($intied->{JOB}) ;
+    ok $intied->is_job() ;
+    ok $intied->is_job(), 'TEST-UNIT-2' ;
+&info("Control private inserted value is there");
+    ok $intied->{"TESTUNIT-$$"} , '__PRIVATE__' ;
+    #&dump_hash ;
+
+untie %tied__hash ;
+&info("Reopen as writer and get new status");
+    ok defined(tie( %tied__hash, 'GDBM_File', $tie_file, GDBM_WRCREAT, 0660)) ;
+    $cache_hashref->{__GDBM_WRITER__} = 1 ;
+
+    $intied = new A2P::Status( $cache_hashref, \%tied__hash, 'TEST-UNIT-3' );
+    ok defined($intied) and ref($intied) =~ /^A2P::Status$/ ;
+    ok $intied->get_revision(), 0 ;
+
+&info("Test API used by tied_update_status in A2P::JobStatus");
+    &info("Check cache_timer call");
+    ok $intied->cache_timer ;
+    &info("Check step_status call");
+    ok $intied->step_status ;
+    ok $intied->step_status(-1), 0 ;
+    ok $intied->step_status(0), 'o';
+    ok $intied->step_status(12), '_';
+    ok $intied->{STATE}->[12], '_' ;
+    ok ! $intied->step_status(20);
+    ok $intied->step_status(5), '_' ;    # if char '0' return '_'
+    ok $intied->step_status(5);          # Still true by default
+    ok $intied->step_status(5,'0'), '.'; # Can't set '0' but '.' as default
+    ok $intied->step_status(12,'X'), 'X' ;
+    ok $intied->step_status(12), 'X';
+    ok $intied->{STATE}->[12], 'X' ;
+    ok $intied->{STEP}, 12 ;
+    #&dump_hash ;
+
+&info("Check infos API");
+    ok $intied->infos(), 1 ;
+    ok $intied->infos(1), 0 ;
+    ok $intied->infos("AA"), 0 ;
+    ok $intied->infos( ( TEST => 111 ) ), 0 ;
+    ok $intied->infos( { TEST => 111 } ), 1 ;
+    ok $intied->infos( [ TEST => 111 ] ), 0 ;
+    ok $intied->{TEST}, 111 ;
+        my @test = 'TEST' ;
+        &info("Try a call with a bad hash (it generates at least a warning)");
+    ok $intied->infos( { @test } ), 1 ;
+    ok $intied->{TEST}, "" ;
+    ok $intied->infos({ THIS => "TESTUNIT" }) ;
+    ok $intied->{THIS}, 'TESTUNIT' ;
+    ok $intied->infos( { THIS => "   " }) ;
+    ok $intied->{THIS}, '' ;
+    ok $intied->infos( { JOBID => 'UNIT-TEST' } ), 1 ;
+    ok $intied->{JOBID}, 'UNIT-TEST' ;
+    ok $intied->cached ;
+    ok defined($cache_hashref->{'TEST-UNIT-3'}) ;
+    ok $cache_hashref->{'TEST-UNIT-3'}, $intied ;
+    ok defined($cache_hashref->{'UNIT-TEST'}) ;
+    ok $cache_hashref->{'UNIT-TEST'}, $intied ;
+
+&info("Check current_in_tie_sid_key API");
+    ok $intied->get_sid_index, 0 ;
+    ok $intied->current_in_tie_sid_key , 'TEST-UNIT-3' ;
+
+&info("Check status API");
+    ok $intied->infos( { STATUS => "done" } ) ;
+    ok $intied->{STATUS}, 'done' ;
+    ok $intied->status, 'DONE' ;
+    ok $intied->{STATUS}, 'DONE' ;
+
+&info("Check save_tied call");
+    $intied = new A2P::Status( $cache_hashref, \%tied__hash, 'TEST-UNIT-4' );
+    ok $intied->get_revision(), 0 ;
+    ok $intied->save_tied(), $intied ;
+    ok $intied->get_revision(), 1 ;
+    ok defined($tied__hash{'TEST-UNIT-4'}) ;
+    $cache_hashref->{__GDBM_WRITER__} = 0 ;
+    &info("Must not save_tied and return 0");
+    ok $intied->save_tied(), 0 ;
+    ok $intied->get_revision(), 2 ;
+    $cache_hashref->{__GDBM_WRITER__} = 1 ;
+
+&info("Check about revision API");
+    ok $intied->get_revision(), 2 ;
+    ok $intied->{REV}, 2 ;
+    ok $intied->set_revision(), 3 ;
+    ok $intied->get_revision(), 3 ;
+    ok $intied->{REV}, 3 ;
+    ok $intied->set_revision(), 4 ;
+    ok $intied->{REV}, 4 ;
+
+&info("Check current_in_tie_sid_key API");
+    ok $intied->current_in_tie_sid_key , 'TEST-UNIT-4' ;
+
+&info("Simulating SID updates from another thread:");
+    $LOCKID = "SIMUL-1" ;
+    $0 = "TEST-Status-SM" , A2P::Syslog::SetLogger(0);
+    &info("1. First call initialize the status object");
+    $status = new A2P::Status( $cache_hashref, \%tied__hash, 'TEST-UNIT-5' );
+    ok $status->step_status ;
+    ok $status->infos ;
+    ok $status->cached ;
+    ok $s{timer1} = $status->cache_timer ;
+        $s{timer2} = $status->timer ;
+    ok $s{timer1} , $s{timer2} ;
+    ok $status->save_tied , $status ;
+    ok $cache_hashref->{'TEST-UNIT-5'} , $status ;
+    ok ! exists($cache_hashref->{'SIMULATION-1'}) ;
+    ok $status->get_revision , 1 ;
+    ok $status->get_sid_index , 0 ;
+    ok $status->get_sid_key , 'TEST-UNIT-5' ;
+    ok $status->get_sid_version_key , 'TEST-UNIT-5_rev' ;
+        $s{version} = &thaw($tied__hash{'TEST-UNIT-5_rev'}) ;
+    ok @{$s{version}} , 3 ;
+    ok $s{version}->[0] , 1 ;
+    ok $s{version}->[1] , "SIMUL-1" ;
+    ok $s{version}->[2] , $s{timer2} ;
+    undef $status ;
+    ok defined($tied__hash{'TEST-UNIT-5'}) ;
+    ok defined($tied__hash{'TEST-UNIT-5_rev'}) ;
+    ok $tied__hash{'SIMULATION-1'} , undef ;
+    #&dump_hash ;
+
+    &info("2. Second call initialize the status itself and a private value");
+    $status = new A2P::Status( $cache_hashref, \%tied__hash, 'TEST-UNIT-5' );
+    ok $status->step_status(1,'.') , '.';
+    ok $status->infos({ STATUS => 'WAITING', FILE => 'TEST.test-unit-5' });
+    ok $status->cached ;
+    ok $status->cache_timer ;
+    ok $status->save_tied , $status ;
+    ok $cache_hashref->{'TEST-UNIT-5'} , $status ;
+    ok ! exists($cache_hashref->{'SIMULATION-1'}) ;
+    undef $status ;
+    ok defined($tied__hash{'TEST-UNIT-5'}) ;
+    ok defined($tied__hash{'TEST-UNIT-5_rev'}) ;
+        $s{version} = &thaw($tied__hash{'TEST-UNIT-5_rev'}) ;
+    ok @{$s{version}} , 3 ;
+    ok $s{version}->[0] , 2 ;
+    ok $tied__hash{'SIMULATION-1'} , undef ;
+
+    &info("3. Third call initialize the JID");
+    $status = new A2P::Status( $cache_hashref, \%tied__hash, 'TEST-UNIT-5' );
+    ok $status->step_status(1,'o') , 'o';
+    ok $status->step_status(1,'o') , 'o';
+    ok $status->step_status(1,'-') , 'o';
+    ok $status->infos({ JID => 'SIMULATION-1', STATUS => 'STARTING',
+        FILE => 'TEST/test-unit-5' });
+    ok $status->cached ;
+    ok $status->cache_timer ;
+    ok $status->save_tied , $status ;
+    ok $cache_hashref->{'TEST-UNIT-5'} , $status ;
+    ok $cache_hashref->{'SIMULATION-1'}, $status ;
+    undef $status ;
+    ok defined($tied__hash{'TEST-UNIT-5'}) ;
+    ok defined($tied__hash{'TEST-UNIT-5_rev'}) ;
+        $s{version} = &thaw($tied__hash{'TEST-UNIT-5_rev'}) ;
+    ok @{$s{version}} , 3 ;
+    ok $s{version}->[0] , 3 ;
+    ok $tied__hash{'SIMULATION-1'} , 'TEST-UNIT-5' ;
+
+    $cache_hashref = { __GDBM_WRITER__ => 1 } ;
+    #&dump_hash ;
+
+    &info("4. Next update from converter using another cache");
+    $0 = "TEST-Status-CO" , A2P::Syslog::SetLogger(0);
+    $cache_hashref_2->{__GDBM_WRITER__} = 1 ;
+    $status = new A2P::Status( $cache_hashref_2, \%tied__hash, 'TEST-UNIT-5' );
+    ok $status->step_status(2,'.') , '.';
+    ok $status->infos({ JID => 'SIMULATION-1' });
+    ok $status->cached ;
+    ok $status->cache_timer ;
+    ok $status->save_tied , $status ;
+    ok $cache_hashref_2->{'TEST-UNIT-5'} , $status ;
+    ok $cache_hashref_2->{'SIMULATION-1'}, $status ;
+    ok $cache_hashref_2->{'__SID__'}->{3}, undef ;
+    undef $status ;
+    ok defined($tied__hash{'TEST-UNIT-5'}) ;
+    ok defined($tied__hash{'TEST-UNIT-5_rev'}) ;
+        $s{version} = &thaw($tied__hash{'TEST-UNIT-5_rev'}) ;
+    ok @{$s{version}} , 3 ;
+    ok $s{version}->[0] , 4 ;
+    ok $tied__hash{'SIMULATION-1'} , 'TEST-UNIT-5' ;
+
+    &info("5. Clear the cache to simulate check from a2p-status as reader");
+    $cache_hashref = { __GDBM_WRITER__ => 0 } ;
+    #&dump_hash ;
+
+    &info("6. In the same time a2p-status get the status and update it in DB");
+    $0 = "TEST-Status-DB" , A2P::Syslog::SetLogger(0);
+    $status = new A2P::Status( $cache_hashref, \%tied__hash, 'TEST-UNIT-5' );
+
+    &info("Check current_in_tie_sid_key API");
+    ok $status->current_in_tie_sid_key , 'TEST-UNIT-5' ;
+
+    ok $cache_hashref->{'TEST-UNIT-5'} , $status ;
+    ok $cache_hashref->{'SIMULATION-1'}, $status ;
+    ok $status->get_sid_index , 0 ;
+    &info("7. Here a sync with DB result in a change of SID");
+    ok A2P::Status::_found_sid() , 0 ;
+    ok $status->{DB}->{SID} , undef ;
+    $status->{PREVIOUS_SID} = 'TEST-UNIT-5' ;
+    $status->{SID} = $status->{DB}->{SID} = 3 ;
+    ok $status->get_revision, 4 ;
+    $status->{DB}->{REV} = $status->get_revision ;
+    ok $status->get_sid_index , 3 ;
+    $cache_hashref->{'__SID__'}->{$status->get_sid_index} = $status ;
+    ok A2P::Status::_found_sid(3), 3 ;
+    ok A2P::Status::_found_sid() , 4 ;
+    ok $status->cache_timer ;
+    #&dump_hash ;
+
+    &info("Check current_in_tie_sid_key API");
+    ok $status->current_in_tie_sid_key , 'TEST-UNIT-5' ;
+
+    &info("8. Check we can't update status tied hash");
+    ok $status->get_revision, 4 ;
+    ok $status->save_tied , 0 ;
+    ok $status->get_revision, 5 ;
+    ok $cache_hashref->{'TEST-UNIT-5'} , $status ;
+    ok $cache_hashref->{'SIMULATION-1'}, $status ;
+    ok $cache_hashref->{'__SID__'}->{3}, $status ;
+    ok defined($tied__hash{'TEST-UNIT-5'}) ;
+    ok defined($tied__hash{'TEST-UNIT-5_rev'}) ;
+        $s{version} = &thaw($tied__hash{'TEST-UNIT-5_rev'}) ;
+    ok @{$s{version}} , 3 ;
+    ok $s{version}->[0] , 4 ;
+    ok ! exists($tied__hash{'_SID_3'}) ;
+    ok ! exists($tied__hash{'_SID_3_rev'}) ;
+    ok $tied__hash{'SIMULATION-1'} , 'TEST-UNIT-5' ;
+    #&dump_hash ;
+
+    &info("9. Retry to update tied hash");
+    $cache_hashref->{__GDBM_WRITER__} = 1 ;
+    undef $status ;
+    $status = new A2P::Status( $cache_hashref, \%tied__hash, 'TEST-UNIT-5' );
+    ok $cache_hashref->{'TEST-UNIT-5'} , $status ;
+    ok $cache_hashref->{'SIMULATION-1'}, $status ;
+    ok $status->get_sid_index , 3 ;
+    ok $cache_hashref->{'__SID__'}->{3}, $status ;
+    &info("Here sync_with_db simulates a change of SID with PREVIOUS_SID");
+    ok $status->{SID} , 3 ;
+    ok $status->get_sid_index , 3 ;
+    ok $status->{PREVIOUS_SID} , 'TEST-UNIT-5' ;
+    ok $status->{DB}->{SID} , 3 ;
+    ok $status->cache_timer ;
+
+    &info("10. Check we have updated status tied hash");
+    ok $status->save_tied , $status ;
+    # Only deleted after save_tied in sync_with_db
+    delete $tied__hash{'TEST-UNIT-5_rev'} ;
+    ok $status->get_revision, 6 ;
+    ok $cache_hashref->{'TEST-UNIT-5'} , $status ;
+    ok $cache_hashref->{'SIMULATION-1'}, $status ;
+    ok $cache_hashref->{'__SID__'}->{3}, $status ;
+    ok $tied__hash{'TEST-UNIT-5'} , '3' ;
+    ok ! exists($tied__hash{'TEST-UNIT-5_rev'}) ;
+    ok defined($tied__hash{'_SID_3'}) ;
+    ok defined($tied__hash{'_SID_3_rev'}) ;
+        $s{version} = &thaw($tied__hash{'_SID_3_rev'}) ;
+    ok @{$s{version}} , 3 ;
+    ok $s{version}->[0] , 6 ;
+    ok $tied__hash{'SIMULATION-1'} , 'TEST-UNIT-5' ;
+
+    &info("Check current_in_tie_sid_key API");
+    ok $status->current_in_tie_sid_key , '_SID_3' ;
+    undef $status ;
+
+    &info("11. Following check as reader are done with new SID key");
+    $cache_hashref->{__GDBM_WRITER__} = 0 ;
+    undef $status ;
+    $status = new A2P::Status( $cache_hashref, \%tied__hash, '_SID_3' );
+    ok $status->get_revision, 6 ;
+    ok $status->get_sid_index , 3 ;
+    $cache_hashref->{'__SID__'}->{$status->get_sid_index} = $status ;
+    #&dump_hash ;
+
+    &info("Check current_in_tie_sid_key API");
+    ok $status->current_in_tie_sid_key , '_SID_3' ;
+
+    &info("12. Use the other cache and control SID is not troubled");
+    $0 = "TEST-Status-CO" , A2P::Syslog::SetLogger(0);
+    $status = new A2P::Status( $cache_hashref_2, \%tied__hash, 'TEST-UNIT-5' );
+
+    &info("Check current_in_tie_sid_key API");
+    ok $status->current_in_tie_sid_key , '_SID_3' ;
+
+    ok $status->step_status(2,'o') , 'o';
+    ok $status->infos ;
+    ok $status->cached ;
+    ok $status->cache_timer ;
+    #&dump_hash ;
+    ok $status->save_tied , $status ;
+    ok $status->get_revision, 7 ;
+    ok $cache_hashref_2->{'TEST-UNIT-5'} , $status ;
+    ok $cache_hashref_2->{'SIMULATION-1'}, $status ;
+    ok $cache_hashref_2->{'__SID__'}->{3}, $status ;
+    ok ! exists($tied__hash{'TEST-UNIT-5_rev'}) ;
+    ok defined($tied__hash{'_SID_3'}) ;
+    ok defined($tied__hash{'_SID_3_rev'}) ;
+    ok defined($tied__hash{'_SID_3_rev'}) ;
+        $s{version} = &thaw($tied__hash{'_SID_3_rev'}) ;
+    ok @{$s{version}} , 3 ;
+    ok $s{version}->[0] , 7 ;
+    ok $tied__hash{'SIMULATION-1'} , 'TEST-UNIT-5' ;
+    ok $tied__hash{'TEST-UNIT-5'}  , '3' ;
+    undef $status ;
+
+&info("Check remove_from_cache call");
+    $cache_hashref->{__GDBM_WRITER__} = 1 ;
+    $intied = new A2P::Status( $cache_hashref, \%tied__hash, 'TEST_UNIT_6' );
+    ok $intied->save_tied(), $intied ;
+    ok defined($tied__hash{'TEST_UNIT_6'}) ;
+    ok $cache_hashref->{'TEST_UNIT_6'}, $intied ;
+    $intied->remove_from_cache ;
+    ok defined($tied__hash{'TEST_UNIT_6'}) ;
+    ok $cache_hashref->{'TEST_UNIT_6'}, undef ;
+
+&info("Check cache/timer info APIs");
+    ok $cache_hashref->{__GDBM_WRITER__} ;
+    $status = new A2P::Status( $cache_hashref, \%tied__hash, 'TEST_UNIT_7' );
+    ok $status->cached ;
+    ok exists($cache_hashref->{'TEST_UNIT_7'}) ;
+    ok $cache_hashref->{'TEST_UNIT_7'}, $status ;
+    ok exists($cache_hashref->{'TEST_UNIT_7'}->{TIMER}) ;
+    ok $cache_hashref->{'TEST_UNIT_7'}->{TIMER} ;
+    ok $cache_hashref->{'TEST_UNIT_7'}->timer ;
+        my $timer = $cache_hashref->{'TEST_UNIT_7'}->{TIMER} ;
+    ok $cache_hashref->{'TEST_UNIT_7'}->timer, $timer ;
+
+&info("Check compared_with_one_from_tiehash API");
+    ok $status->get_revision, 0 ;
+    ok $status->save_tied(), $status ;
+    ok $status->get_revision, 1 ;
+    ok defined($tied__hash{'TEST_UNIT_7'}) ;
+        my $dirty = $status->clone ;
+    ok $status->save_tied(), $status ;
+    ok $status->get_revision, 2 ;
+    ok $dirty->get_revision, 1 ;
+        # Dirty cache entry
+    ok $status->compared_with_one_from_tiehash, $status ;
+        my $updated = $dirty->compared_with_one_from_tiehash ;
+    ok $updated != $dirty ;
+    ok $updated->get_revision, 2 ;
+        $updated->cached ;
+    ok $cache_hashref->{'TEST_UNIT_7'}, $updated ;
+    ok $dirty->get_revision, 1 ;
+    ok $dirty->set_revision, 2 ;
+    ok $dirty->compared_with_one_from_tiehash, $dirty ;
+    ok $dirty->set_revision, 3 ;
+    ok $dirty->compared_with_one_from_tiehash, $dirty ;
+    ok $cache_hashref->{'TEST_UNIT_7'} != $dirty ;
+
+$do_next_test = 0 ;
+if ($do_next_test) { # This long test should normally be disabled
+&info("Check remove_from_tied_hash API timing");
+    $status = new A2P::Status( $cache_hashref, \%tied__hash, 'TEST_UNIT_8' );
+    my $ostatus = new A2P::Status( $cache_hashref, \%tied__hash, 'TEST_UNIT_9' );
+    ok $status->save_tied(), $status ;
+    ok $ostatus->save_tied(), $ostatus ;
+    ok defined($tied__hash{'TEST_UNIT_8'}) ;
+        my $i = 0 ;
+        while ( $i++ < 10000 ) {
+            #&dump_hash if ( $i == 10 );
+            $status->is_job('TEST_UNIT_8_ref_'.$i);
+            $status->save_tied();
+            $ostatus->is_job('TEST_UNIT_9_ref_'.$i);
+            $ostatus->save_tied();
+        }
+        $status->set_sid_index(500);
+        $status->save_tied ;
+        $ostatus->set_sid_index(5000);
+        $ostatus->save_tied ;
+    my ( $size, $maxsize ) = ( -s $tie_file, 3000000 );
+    &info("Memory file size = $size bytes");
+    $size > $maxsize ? ok $size, $maxsize : ok 1 ;
+    my ( $timing, $maxtiming ) = ( $STATS{'TIMING-SAVE-TIED-MAX'}, 20000 );
+    &info("Max save to tied timing = $timing");
+    $timing > $maxtiming ? ok $timing, $maxtiming : ok 1 ;
+        $status->remove_from_cache ;
+        $status->remove_from_tied_hash();
+    ( $timing, $maxtiming ) = ( $STATS{'TIMING-REMOVE-FROM-TIED-MAX'}, 700000 );
+    &info("Max remove timing = $timing");
+    $timing > $maxtiming ? ok $timing, $maxtiming : ok 1 ;
+        my $tiedhash = tied( %tied__hash ) ;
+    ok ref($tiedhash) , 'GDBM_File' ;
+    &info("Shrinking memory file...");
+        my $shrinked = -s $tie_file ? $tiedhash->reorganize() : 0 ;
+        undef $tiedhash ;
+    (defined($shrinked) and $shrinked >= 0) ? ok $shrinked, 0 : ok 0 ;
+    ( $size, $maxsize ) = ( -s $tie_file, 1200000 );
+    &info("Shrinked memory file size = $size bytes");
+    $size > $maxsize ? ok $size, $maxsize : ok 1 ;
+}
+
+# Clean
+#&dump_hash ;
+untie %tied__hash ;
+unlink $tie_file ;
+
+exit(0) ;
Index: /A2P/a2p/test/A2P/Tools.pm
===================================================================
--- /A2P/a2p/test/A2P/Tools.pm	(revision 3)
+++ /A2P/a2p/test/A2P/Tools.pm	(revision 3)
@@ -0,0 +1,117 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+use strict ;
+use Test ;
+
+require 'test/A2P/Defaults.pm' ;
+
+BEGIN {
+    plan
+        tests  => 3 ,
+        onfail => sub { exit(1) }
+}
+
+our ( $SHMDIR, $ADVANCED_DEBUGGING, $LOCKID, $LOGFILENAME, $DEBUG_IN_FILE );
+our $Progname = 'TEST-Tools' ;
+
+&info("Loading A2P::Tools library");
+ok require A2P::Tools ;
+
+&info("Control shortID without parameter");
+    sub ShortID    ; *ShortID = \&A2P::Tools::ShortID ;
+    my $id = &ShortID ;
+ok	defined($id);
+ok  length($id), 4;
+ok 	\$id =~ /^SCALAR/ ;
+
+    my @list = split(//,$id);
+    my @cons = split(//,'bcdfgjklmnprstvxz');
+    my @voy  = split(//,'aeiou' );
+    my $i = 0;
+    while ( $i < length($id)) {
+        if	($i % 2 == 0) {
+ok			grep {/^$list[$i]$/} (length($id)%2 == 0)?@cons:@voy;
+        }
+        else {
+ok			grep {/^$list[$i]$/} (length($id)%2 == 0)?@voy:@cons;
+        }
+        $i++;
+    }
+
+&info("Control shortID with parameter 5");
+    $id = &ShortID(5) ;
+ok	defined($id);
+ok  length($id), 5;
+ok 	\$id =~ /^SCALAR/ ;
+
+    @list = split(//,$id);
+    @cons = split(//,'bcdfgjklmnprstvxz');
+    @voy  = split(//,'aeiou' );
+    $i = 0;
+    while ( $i < length($id)) {
+        if	($i % 2 == 0) {
+ok			grep {/^$list[$i]$/} (length($id)%2 == 0)?@cons:@voy;
+        }
+        else {
+ok			grep {/^$list[$i]$/} (length($id)%2 == 0)?@voy:@cons;
+        }
+        $i++;
+    }
+
+&info("Check SharedList API");
+    my $base = $SHMDIR . '/.shared-list-TEST' ;
+    unlink glob($base.'*');
+ok ! -e $base ;
+ok ! -e $base . '.LCK' ;
+    sub SharedList ; *SharedList = \&A2P::Tools::SharedList ;
+    sub FreeSharedList ; *FreeSharedList = \&A2P::Tools::FreeSharedList ;
+    my $list = &SharedList('TEST');
+ok $list ;
+ok ref($list), 'ARRAY' ;
+ok scalar(@{$list}), 0 ;
+ok -e $base ;
+ok -e $base . '.LCK' ;
+    my $lck = qx(/usr/sbin/lsof -l $base.LCK  2>&1 | tee /tmp/tools-locking.log 2>&1) ;
+    &info("Check lsof result:", $lck, "toward: perl $$ $< [0-9]+wW REG [0-9,]+ 0");
+ok $lck ;
+ok $lck =~ /perl\s+$$\s+$<\s+\d+wW\s+REG\s+[0-9,]+\s+0\s+/ ;
+    push @{$list}, 'BEGIN', 'VALUE' ;
+ok scalar(@{$list}), 2 ;
+ok $list->[1], 'VALUE' ;
+    &FreeSharedList('TEST') ;
+
+    $lck = qx(/usr/sbin/lsof -l $base.LCK  2>&1 | tee /tmp/tools-locking.log 2>&1) ;
+    &info("Check lsof result:", $lck, "toward: perl $$ $< [0-9]+wW REG [0-9,]+ 0");
+ok $lck !~ /perl\s+$$\s+$<\s+\d+wW\s+REG\s+[0-9,]+\s+0\s+/ ;
+
+    push @{$list}, 'LAST' ;
+    undef $list ;
+    $list = &SharedList('TEST');
+ok scalar(@{$list}), 2 ;
+    push @{$list}, 'TEST', 'END' ;
+ok scalar(@{$list}), 4 ;
+ok shift @{$list}, 'BEGIN' ;
+ok $list->[1], 'TEST' ;
+    &FreeSharedList('TEST') ;
+
+exit(0) ;
Index: /A2P/a2p/test/a2p-test.pl
===================================================================
--- /A2P/a2p/test/a2p-test.pl	(revision 3)
+++ /A2P/a2p/test/a2p-test.pl	(revision 3)
@@ -0,0 +1,161 @@
+#! /usr/bin/perl -w
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Unit tests launcher
+#
+
+use Carp qw(longmess);
+
+$quiet = defined($ENV{DEBUG}) ? $ENV{DEBUG} == 0 : 1 ;
+
+die "Environment A2P_PATH not set\n"
+    unless (defined($ENV{A2P_PATH}));
+
+die "A2P_PATH not set to a valid folder\n"
+    unless ( -d $ENV{A2P_PATH} );
+
+$| = 1 ;
+
+chdir $ENV{A2P_PATH} ;
+$folder = `pwd` ;
+chomp $folder ;
+die "Specified A2P_PATH ($folder) not contains the required 'test' folder\n"
+    unless ( -d $folder .'/test' );
+
+print "PID=$$\nScript=$0\nFolder=$folder\n" unless $quiet ;
+$0 = '__A2P_TEST__' ;
+
+%scripts = () ;
+
+# 1. Scan test folders
+# 1.1. Scan base test folder
+opendir TEST, $folder . '/test'
+    or die "Can't opendir 'test'\n" ;
+
+foreach ( readdir TEST ) {
+    if ( -d $_ and /\w+/ ) {
+        push @test_folders, $_ ;
+    } elsif ( /\.pl$/ and ! m|a2p-test\.pl$| and -x $_ ) {
+        push @test_scripts, $folder . '/test/' . $_  ;
+    }
+}
+close TEST ;
+
+# 1.2. Sort base test scripts
+@test_scripts = sort(@test_scripts) ;
+
+# 1.3. Scan sub test folder
+for $dir (sort(@test_folders)) {
+    @scripts = () ;
+    $clean = "" ;
+    $thisfolder = "$folder/test/$dir" ;
+    opendir TEST, $thisfolder
+        or die "Can't opendir '$thisfolder'\n" ;
+    foreach ( readdir TEST ) {
+        next if /Defaults\.pm$/ ;
+        next unless /\.p[lm]$/ ;
+        $thisfile = $thisfolder . '/' . $_ ;
+        next unless ( ! -d $thisfile and -x $thisfile );
+        if (m|test-init.pl$|) {
+            push @test_scripts , $thisfile ;
+        } elsif (m|test-clean.pl$|) {
+            $clean = $thisfile ;
+        } else {
+            push @scripts, $thisfile ;
+        }
+    }
+    close TEST ;
+    push @test_scripts, sort(@scripts);
+    push @test_scripts, $clean if $clean ;
+}
+
+print "Found ".(@test_scripts)." scripts to run: " ;
+print join( ", ", map { m|([^/]+)$| } @test_scripts ), "\n" unless ($quiet) ;
+
+$stdout = "" ;
+
+sub head {
+    return "=" x 80 , "\n", "=== UNIT TEST @_: ",
+        $script =~ m|^$folder/(test/.*)$|, "\n",
+        "=" x 80 , "\n",
+}
+
+my @checks_re = (
+    "^untie attempted while"
+);
+@checks_re = map { qr/$_/ } @checks_re ;
+
+sub known_warns {
+    my $ref = shift ;
+    my @warn = () ;
+    foreach my $line (@{$ref}) {
+        push @warn, $line if ( grep { $line =~ $_ } @checks_re );
+    }
+    $quiet = 0 if @warn ;
+    return @warn ;
+}
+
+@warns = () ;
+$count = 0 ;
+
+$SIG{__WARN__} = $SIG{__DIE__} =sub {
+    $quiet = 0 ;
+    my $mesg = &longmesg(@_) ;
+    push @{$warns[$count]}, $mesg ;
+    print "$mesg\n" ;
+    } ;
+
+# 2. Do tests
+@scripts = () ;
+@failed = () ;
+foreach $script (@test_scripts) {
+    $count ++ ;
+    $scripts[$count] = $script ;
+    $quiet = defined($ENV{DEBUG}) ? $ENV{DEBUG} == 0 : 1 ;
+    @stdout = qx( perl -W $script 2>&1 ) ;
+    push @{$warns[$count]}, &known_warns(\@stdout) ;
+    if ($?) {
+        $quiet = 0 ;
+        print "unit test #$count failed\n" ;
+        my @KOs = map { /(\d+)/ } grep { /^not ok \d+$/ } @stdout ;
+        $" = ', ' ;
+        push @{$warns[$count]}, "KO tests: @KOs" if @KOs ;
+        push @failed, $count ;
+    }
+
+    $" = "\n" ;
+    print $quiet ? "." : ( &head($count), "@stdout\n" ) ;
+}
+
+print "\nGood: ".($count-@failed)."/$count\nKO: ".@failed."\n" ;
+
+$" = "\n" ;
+map {
+    print "Failed: $scripts[$_]\n" ;
+    print "@{$warns[$_]}\n" if (ref($warns[$_]) =~ /^ARRAY/ and @{$warns[$_]}) ;
+    $warns[$_] = 0 ;
+    } @failed ;
+@warns = grep { defined($_) and ref($_) =~ /^ARRAY/ and @{$_} } @warns ;
+print "Other warnings:\n" if (@warns);
+map { print "@{$_}" } @warns ;
+
+exit(0);
Index: /A2P/a2p/test/build.xml
===================================================================
--- /A2P/a2p/test/build.xml	(revision 3)
+++ /A2P/a2p/test/build.xml	(revision 3)
@@ -0,0 +1,46 @@
+<?xml version="1.0"?>
+<!--
+
+Copyright (c) 2004-2007 - Consultas, PKG.fr
+
+This file is part of A2P.
+
+A2P is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+A2P 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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with A2P; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+
+$Id$
+
+-->
+<project name="A2P-Tests" default="Do Tests">
+
+    <target name="Do Tests" >
+        <exec executable="perl">
+            <env key="LANG" value="C" />
+            <env key="A2P_PATH" value="${basedir}/.." />
+            <arg line="${basedir}/a2p-test.pl"/>
+        </exec>
+    </target>
+
+    <target name="Do Verbose Tests" >
+        <exec executable="perl">
+            <env key="SHOW_TRIES" value="1" />
+            <env key="DEBUG" value="1" />
+            <env key="LANG" value="C" />
+            <env key="A2P_PATH" value="${basedir}/.." />
+            <arg line="${basedir}/a2p-test.pl"/>
+        </exec>
+    </target>
+
+</project>
+
Index: /A2P/a2p/test/e-adresse-a2p.xml
===================================================================
--- /A2P/a2p/test/e-adresse-a2p.xml	(revision 3)
+++ /A2P/a2p/test/e-adresse-a2p.xml	(revision 3)
@@ -0,0 +1,3 @@
+<a2p pdf='test/e-adresse-test.pdf' file='test/e-adresse-good.xml'>
+    <service name='e-adresse'/>
+</a2p>
Index: /A2P/a2p/test/e-adresse-good.xml
===================================================================
--- /A2P/a2p/test/e-adresse-good.xml	(revision 3)
+++ /A2P/a2p/test/e-adresse-good.xml	(revision 3)
@@ -0,0 +1,15 @@
+<?xml version="1.0" encoding="ISO-8859-1"?>
+<eadresse id='test-0000' importance='normal' sensitivity='normal'
+    notification='no' confirmation='no'>
+<rcpt type='from' name='Test (éïùü)'>abuse@pkg.fr</rcpt>
+<rcpt type='to' name='Test'>abuse@pkg.fr</rcpt>
+<subject>Test (éïùü)</subject>
+<body>Bonjour,
+
+veuillez trouver ci-joint un fichier de test.
+
+Merci et bonne journée,
+
+L'équipe PKG.
+</body>
+</eadresse>
Index: /A2P/a2p/test/e-adresse.conf
===================================================================
--- /A2P/a2p/test/e-adresse.conf	(revision 3)
+++ /A2P/a2p/test/e-adresse.conf	(revision 3)
@@ -0,0 +1,93 @@
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+# Configuration example for e-adresse.pl
+#
+
+################################################################################
+# SMTP configuration
+#
+our %SMTP = (
+    # API mode as key
+    _smtp => {
+        # hostname or IP			remote SMTP port
+        '192.168.0.1'			=>    		25,
+        },
+
+    sub => {
+        test	=>	sub {
+                        open SMTP, '>', '/tmp/e-adresse.txt' or return 0 ;
+                        print SMTP "Host: $_[1]\nMessage:", $_[0]->as_string ;
+                        close(SMTP);
+                        return 1 ;
+                    }
+        },
+    order => [ 'smtp' , 'sendmail', 'sub' ]
+    );
+
+################################################################################
+# Composition configuration
+#
+our %body = (
+    disposition => 'inline',
+    type		=> 'text/plain',
+    encoding	=> '8bit',
+    charset		=> 'iso-8859-1'
+    );
+
+our %attachment = (
+    disposition => 'inline',
+    type		=> 'application/pdf',
+    encoding	=> 'base64',
+    name        => 'from subject',
+    name_re     => qr/:\s+([^#]+)\s+#\s+([^#]+)\s+#\s+([^#]+)\s+#/,
+    name_printf => '%s-%s-%s.pdf',
+    skip		=> 0
+    );
+
+################################################################################
+# Mailing configuration
+#
+our %From = (
+    'address'	=> 	'abuse@pkg.fr',
+    'name'		=>	'Guillaume Bougard',
+    'active'	=>	0
+    );
+our %To = (
+    'address'	=> 	'abuse_test@pkg.fr',
+    'name'		=>	'Guillaume Bougard',
+    'replace'	=>	0,
+    'active'	=>	0
+    );
+our %Cc = (
+    'address'	=> 	'abuse_test@pkg.fr',
+    'name'		=>	'Guillaume Bougard',
+    'replace'	=>	0,
+    'active'	=>	0
+    );
+our %Bcc = (
+    'address'	=> 	'abuse_test@pkg.fr',
+    'name'		=>	'Guillaume Bougard',
+    'replace'	=>	0,
+    'active'	=>	0
+    );
+
+1 ;
Index: /A2P/a2p/test/e-adresse.pl
===================================================================
--- /A2P/a2p/test/e-adresse.pl	(revision 3)
+++ /A2P/a2p/test/e-adresse.pl	(revision 3)
@@ -0,0 +1,57 @@
+#! /usr/bin/perl
+#
+# Copyright (c) 2004-2007 - Consultas, PKG.fr
+#
+# This file is part of A2P.
+#
+# A2P is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# A2P 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with A2P; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+#
+# $Id$
+#
+
+use strict ;
+use Test ;
+
+require 'test/A2P/Defaults.pm' ;
+
+use warnings FATAL => qw(void);
+
+BEGIN {
+    plan
+        tests  => 7,
+        onfail => sub { exit(1) }
+}
+
+$| = 1 ;
+
+$ENV{JOB} = "TEST-JOB-EADRESSE" ;
+
+my $script = "LANG=C EADRESSE_CONF=test perl e-adresse.pl" ;
+# We should start the script in each possible mode with a test file
+
+# A simple call must fail as script is expecting something to do
+ok system( $script);
+# A call with a bad file must fail, also if more than 2 args are given
+ok system( $script . ' test/e-adresse-good.xml' );
+ok system( $script . ' test/e-adresse-good.xml test/e-adresse-a2p.xml' );
+
+# A call with a right formatted file must return 0
+my $mail = '/tmp/e-adresse.txt' ;
+unlink $mail if -s $mail ;
+ok ! system( $script . ' test/e-adresse-a2p.xml' );
+ok -s $mail ;
+unlink $mail if -s $mail ;
+ok ! system( 'cat test/e-adresse-a2p.xml | ' . $script );
+ok -s $mail ;
Index: /TracAccountManager/0.10/README
===================================================================
--- /TracAccountManager/0.10/README	(revision 3)
+++ /TracAccountManager/0.10/README	(revision 3)
@@ -0,0 +1,29 @@
+= TracAccountManager =
+
+A user account management plugin for Trac.
+
+== Installation ==
+ 1. Run: python setup.py bdist_egg
+ 2. If necessary create a folder called "plugins" in your Trac environment.
+ 3. Copy the .egg file from the dist folder created by step 1 into the "plugins"
+    directory of your Trac environment.
+
+== Configuration ==
+Add one of the following sections to trac.ini to manage an Apache htpasswd or
+htdigest file.
+
+=== Htpasswd ===
+{{{
+[account-manager]
+password_format = htpasswd
+password_file = /path/to/trac.htpasswd
+}}}
+
+=== Htdigest ===
+{{{
+[account-manager]
+password_format = htdigest
+password_file = /path/to/trac.htdigest
+htdigest_realm = TracDigestRealm
+}}}
+
Index: /TracAccountManager/0.10/acct_mgr/admin.py
===================================================================
--- /TracAccountManager/0.10/acct_mgr/admin.py	(revision 3)
+++ /TracAccountManager/0.10/acct_mgr/admin.py	(revision 3)
@@ -0,0 +1,150 @@
+# -*- coding: utf-8 -*-
+#
+# Copyright (C) 2005 Matthew Good <trac@matt-good.net>
+#
+# "THE BEER-WARE LICENSE" (Revision 42):
+# <trac@matt-good.net> wrote this file.  As long as you retain this notice you
+# can do whatever you want with this stuff. If we meet some day, and you think
+# this stuff is worth it, you can buy me a beer in return.   Matthew Good
+#
+# Author: Matthew Good <trac@matt-good.net>
+
+import inspect
+
+from trac.core import *
+from trac.config import Option
+from trac.perm import PermissionSystem
+from trac.util import sorted
+from trac.util.datefmt import format_datetime
+from trac.web.chrome import ITemplateProvider
+from webadmin.web_ui import IAdminPageProvider
+
+from acct_mgr.api import AccountManager
+from acct_mgr.web_ui import _create_user
+
+def _getoptions(cls):
+    if isinstance(cls, Component):
+        cls = cls.__class__
+    return [(name, value) for name, value in inspect.getmembers(cls)
+            if isinstance(value, Option)]
+
+class AccountManagerAdminPage(Component):
+
+    implements(IAdminPageProvider)
+
+    def __init__(self):
+        self.account_manager = AccountManager(self.env)
+
+    # IAdminPageProvider
+    def get_admin_pages(self, req):
+        if req.perm.has_permission('TRAC_ADMIN'):
+            yield ('accounts', 'Comptes', 'config', 'Configuration')
+            yield ('accounts', 'Comptes', 'users', 'Utilisateurs')
+
+    def process_admin_request(self, req, cat, page, path_info):
+        if page == 'config':
+            return self._do_config(req)
+        elif page == 'users':
+            return self._do_users(req)
+
+    def _do_config(self, req):
+        if req.method == 'POST':
+            selected_class = req.args.get('selected')
+            self.config.set('account-manager', 'password_store', selected_class)
+            selected = self.account_manager.password_store
+            for attr, option in _getoptions(selected):
+                newvalue = req.args.get('%s.%s' % (selected_class, attr))
+                if newvalue is not None:
+                    self.config.set(option.section, option.name, newvalue)
+                    self.config.save()
+        try:
+            selected = self.account_manager.password_store
+        except AttributeError:
+            selected = None
+        sections = [
+            {'name': store.__class__.__name__,
+             'classname': store.__class__.__name__,
+             'selected': store is selected,
+             'options': [
+                {'label': attr,
+                 'name': '%s.%s' % (store.__class__.__name__, attr),
+                 'value': option.__get__(store, store),
+                }
+                for attr, option in _getoptions(store)
+             ],
+            } for store in self.account_manager.stores
+        ]
+        sections = sorted(sections, key=lambda i: i['name'])
+        req.hdf['sections'] = sections
+        return 'admin_accountsconfig.cs', None
+
+    def _do_users(self, req):
+        perm = PermissionSystem(self.env)
+        listing_enabled = self.account_manager.supports('get_users')
+        create_enabled = self.account_manager.supports('set_password')
+        delete_enabled = self.account_manager.supports('delete_user')
+
+        req.hdf['listing_enabled'] = listing_enabled
+        req.hdf['create_enabled'] = create_enabled
+        req.hdf['delete_enabled'] = delete_enabled
+
+        if req.method == 'POST':
+            if req.args.get('add'):
+                if create_enabled:
+                    try:
+                        _create_user(req, self.env, check_permissions=False)
+                    except TracError, e:
+                        req.hdf['registration.error'] = e.message
+                else:
+                    req.hdf['registration_error'] = u'L\'espace de stockage des ' \
+                                                    u'mots de passe ne supporte ' \
+                                                    u'pas la création des utilisateurs'
+            elif req.args.get('remove'):
+                if delete_enabled:
+                    sel = req.args.get('sel')
+                    sel = isinstance(sel, list) and sel or [sel]
+                    for account in sel:
+                        self.account_manager.delete_user(account)
+                else:
+                    req.hdf['deletion_error'] = u'L\'espace de stockage des ' \
+                                                u'mots de passe ne supporte ' \
+                                                u'pas la suppression des utilisateurs'
+        if listing_enabled:
+            accounts = {}
+            for username in self.account_manager.get_users():
+                accounts[username] = {'username': username}
+
+            for username, name, email in self.env.get_known_users():
+                account = accounts.get(username)
+                if account:
+                    account['name'] = name
+                    account['email'] = email
+
+            db = self.env.get_db_cnx()
+            cursor = db.cursor()
+            cursor.execute("SELECT sid,last_visit FROM session WHERE authenticated=1")
+            for username, last_visit in cursor:
+                account = accounts.get(username)
+                if account and last_visit:
+                    account['last_visit'] = format_datetime(last_visit)
+
+            req.hdf['accounts'] = sorted(accounts.itervalues(),
+                                         key=lambda acct: acct['username'])
+
+        return 'admin_users.cs', None
+
+    # ITemplateProvider
+
+    def get_htdocs_dirs(self):
+        """Return the absolute path of a directory containing additional
+        static resources (such as images, style sheets, etc).
+        """
+        return []
+
+    def get_templates_dirs(self):
+        """Return the absolute path of the directory containing the provided
+        ClearSilver templates.
+        """
+        from pkg_resources import resource_filename
+        return [resource_filename(__name__, 'templates')]
+
Index: /TracAccountManager/0.10/acct_mgr/api.py
===================================================================
--- /TracAccountManager/0.10/acct_mgr/api.py	(revision 3)
+++ /TracAccountManager/0.10/acct_mgr/api.py	(revision 3)
@@ -0,0 +1,149 @@
+# -*- coding: utf-8 -*-
+#
+# Copyright (C) 2005 Matthew Good <trac@matt-good.net>
+#
+# "THE BEER-WARE LICENSE" (Revision 42):
+# <trac@matt-good.net> wrote this file.  As long as you retain this notice you
+# can do whatever you want with this stuff. If we meet some day, and you think
+# this stuff is worth it, you can buy me a beer in return.   Matthew Good
+#
+# Author: Matthew Good <trac@matt-good.net>
+
+from trac.core import *
+from trac.config import Option, ExtensionOption
+
+class IPasswordStore(Interface):
+    """An interface for Components that provide a storage method for users and
+    passwords.
+    """
+
+    def config_key(self):
+        """
+        '''Deprecated''': new implementations of this interface are not required
+        to implement this method, since the prefered way to configure the
+        `IPasswordStore` implemenation is by using its class name in
+        the `password_store` option.
+
+        Returns a string used to identify this implementation in the config.
+        This password storage implementation will be used if the value of
+        the config property "account-manager.password_format" matches.
+        """
+
+    def get_users(self):
+        """Returns an iterable of the known usernames
+        """
+
+    def has_user(self, user):
+        """Returns whether the user account exists.
+        """
+
+    def set_password(self, user, password):
+        """Sets the password for the user.  This should create the user account
+        if it doesn't already exist.
+        Returns True if a new account was created, False if an existing account
+        was updated.
+        """
+
+    def check_password(self, user, password):
+        """Checks if the password is valid for the user.
+        """
+
+    def delete_user(self, user):
+        """Deletes the user account.
+        Returns True if the account existed and was deleted, False otherwise.
+        """
+
+class IAccountChangeListener(Interface):
+    """An interface for receiving account change events.
+    """
+
+    def user_created(self, user, password):
+        """New user
+        """
+
+    def user_password_changed(self, user, password):
+        """Password changed
+        """
+
+    def user_deleted(self, user):
+        """User deleted
+        """
+
+class AccountManager(Component):
+    """The AccountManager component handles all user account management methods
+    provided by the IPasswordStore interface.
+
+    The methods will be handled by the underlying password storage
+    implementation set in trac.ini with the "account-manager.password_format"
+    setting.
+    """
+
+    implements(IAccountChangeListener)
+
+    _password_store = ExtensionOption('account-manager', 'password_store',
+                                      IPasswordStore)
+    _password_format = Option('account-manager', 'password_format')
+    stores = ExtensionPoint(IPasswordStore)
+    change_listeners = ExtensionPoint(IAccountChangeListener)
+
+    # Public API
+
+    def get_users(self):
+        return self.password_store.get_users()
+
+    def has_user(self, user):
+        return self.password_store.has_user(user)
+
+    def set_password(self, user, password):
+        if self.password_store.set_password(user, password):
+            self._notify('created', user, password)
+        else:
+            self._notify('password_changed', user, password)
+
+    def check_password(self, user, password):
+        return self.password_store.check_password(user, password)
+
+    def delete_user(self, user):
+        if self.password_store.delete_user(user):
+            self._notify('deleted', user)
+
+    def supports(self, operation):
+        try:
+            store = self.password_store
+        except AttributeError:
+            return False
+        else:
+            return hasattr(store, operation)
+
+    def password_store(self):
+        try:
+            return self._password_store
+        except AttributeError:
+            # fall back on old "password_format" option
+            fmt = self._password_format
+            for store in self.stores:
+                config_key = getattr(store, 'config_key', None)
+                if config_key is None:
+                    continue
+                if config_key() == fmt:
+                    return store
+            # if the "password_format" is not set re-raise the AttributeError
+            raise
+    password_store = property(password_store)
+
+    def _notify(self, func, *args):
+        func = 'user_' + func
+        for l in self.change_listeners:
+            getattr(l, func)(*args)
+
+    # IAccountChangeListener methods
+
+    def user_created(self, user, password):
+        self.log.info('Created new user: %s' % user)
+
+    def user_password_changed(self, user, password):
+        self.log.info('Updated password for user: %s' % user)
+
+    def user_deleted(self, user):
+        self.log.info('Deleted user: %s' % user)
+
Index: /TracAccountManager/0.10/acct_mgr/db.py
===================================================================
--- /TracAccountManager/0.10/acct_mgr/db.py	(revision 3)
+++ /TracAccountManager/0.10/acct_mgr/db.py	(revision 3)
@@ -0,0 +1,90 @@
+# -*- coding: utf8 -*-
+#
+# Copyright (C) 2007 Matthew Good <trac@matt-good.net>
+#
+# "THE BEER-WARE LICENSE" (Revision 42):
+# <trac@matt-good.net> wrote this file.  As long as you retain this notice you
+# can do whatever you want with this stuff. If we meet some day, and you think
+# this stuff is worth it, you can buy me a beer in return.   Matthew Good
+#
+# Author: Matthew Good <trac@matt-good.net>
+
+from trac.core import *
+from trac.config import ExtensionOption
+
+from api import IPasswordStore
+from pwhash import IPasswordHashMethod
+
+class SessionStore(Component):
+    implements(IPasswordStore)
+
+    hash_method = ExtensionOption('account-manager', 'hash_method',
+                                  IPasswordHashMethod, 'HtDigestHashMethod')
+
+    def get_users(self):
+        """Returns an iterable of the known usernames
+        """
+        db = self.env.get_db_cnx()
+        cursor = db.cursor()
+        cursor.execute("SELECT DISTINCT sid FROM session_attribute "
+                       "WHERE authenticated=1 AND name='password'")
+        for sid, in cursor:
+            yield sid
+ 
+    def has_user(self, user):
+        db = self.env.get_db_cnx()
+        cursor = db.cursor()
+        cursor.execute("SELECT * FROM session_attribute "
+                       "WHERE authenticated=1 AND name='password' "
+                       "AND sid=%s", (user,))
+        for row in cursor:
+            return True
+        return False
+
+    def set_password(self, user, password):
+        """Sets the password for the user.  This should create the user account
+        if it doesn't already exist.
+        Returns True if a new account was created, False if an existing account
+        was updated.
+        """
+        hash = self.hash_method.generate_hash(user, password)
+        db = self.env.get_db_cnx()
+        cursor = db.cursor()
+        cursor.execute("UPDATE session_attribute "
+                       "SET value=%s "
+                       "WHERE authenticated=1 AND name='password' "
+                       "AND sid=%s", (hash, user))
+        if cursor.rowcount > 0:
+            return False # updated existing password
+        cursor.execute("INSERT INTO session_attribute "
+                       "(sid,authenticated,name,value) "
+                       "VALUES (%s,1,'password',%s)",
+                       (user, hash))
+        return True
+
+    def check_password(self, user, password):
+        """Checks if the password is valid for the user.
+        """
+        db = self.env.get_db_cnx()
+        cursor = db.cursor()
+        cursor.execute("SELECT value FROM session_attribute "
+                       "WHERE authenticated=1 AND name='password' "
+                       "AND sid=%s", (user,))
+        for hash, in cursor:
+            return self.hash_method.check_hash(user, password, hash)
+        return False
+
+    def delete_user(self, user):
+        """Deletes the user account.
+        Returns True if the account existed and was deleted, False otherwise.
+        """
+        if not self.has_user(user):
+            return False
+        db = self.env.get_db_cnx()
+        cursor = db.cursor()
+        cursor.execute("DELETE FROM session_attribute "
+                       "WHERE authenticated=1 AND name='password' "
+                       "AND sid=%s", (user,))
+        # TODO cursor.rowcount doesn't seem to get # deleted
+        # is there another way to get count instead of using has_user?
+        return True
Index: /TracAccountManager/0.10/acct_mgr/htfile.py
===================================================================
--- /TracAccountManager/0.10/acct_mgr/htfile.py	(revision 3)
+++ /TracAccountManager/0.10/acct_mgr/htfile.py	(revision 3)
@@ -0,0 +1,189 @@
+# -*- coding: utf8 -*-
+#
+# Copyright (C) 2005,2006,2007 Matthew Good <trac@matt-good.net>
+#
+# "THE BEER-WARE LICENSE" (Revision 42):
+# <trac@matt-good.net> wrote this file.  As long as you retain this notice you
+# can do whatever you want with this stuff. If we meet some day, and you think
+# this stuff is worth it, you can buy me a beer in return.   Matthew Good
+#
+# Author: Matthew Good <trac@matt-good.net>
+
+from __future__ import generators
+
+import errno
+import os.path
+import fileinput
+
+from trac.core import *
+from trac.config import Option
+
+from api import IPasswordStore
+from pwhash import htpasswd, htdigest
+
+class _RelativePathOption(Option):
+
+    def __get__(self, instance, owner):
+        if instance is None:
+            return self
+        path = super(_RelativePathOption, self).__get__(instance, owner)
+        return os.path.normpath(os.path.join(instance.env.path, path))
+
+
+class AbstractPasswordFileStore(Component):
+    """Base class for managing password files such as Apache's htpasswd and
+    htdigest formats.
+
+    See the concrete sub-classes for usage information.
+    """
+
+    filename = _RelativePathOption('account-manager', 'password_file')
+
+    def has_user(self, user):
+        return user in self.get_users()
+
+    def get_users(self):
+        filename = self.filename
+        if not os.path.exists(filename):
+            return []
+        return self._get_users(filename)
+
+    def set_password(self, user, password):
+        user = user.encode('utf-8')
+        password = password.encode('utf-8')
+        return not self._update_file(self.prefix(user),
+                                     self.userline(user, password))
+
+    def delete_user(self, user):
+        user = user.encode('utf-8')
+        return self._update_file(self.prefix(user), None)
+
+    def check_password(self, user, password):
+        filename = self.filename
+        if not os.path.exists(filename):
+            return False
+        user = user.encode('utf-8')
+        password = password.encode('utf-8')
+        prefix = self.prefix(user)
+        fd = file(filename)
+        try:
+            for line in fd:
+                if line.startswith(prefix):
+                    return self._check_userline(user, password,
+                                                line[len(prefix):].rstrip('\n'))
+        finally:
+            fd.close()
+        return False
+
+    def _update_file(self, prefix, userline):
+        """If `userline` is empty the line starting with `prefix` is
+        removed from the user file.  Otherwise the line starting with `prefix`
+        is updated to `userline`.  If no line starts with `prefix` the
+        `userline` is appended to the file.
+
+        Returns `True` if a line matching `prefix` was updated,
+        `False` otherwise.
+        """
+        filename = self.filename
+        matched = False
+        try:
+            for line in fileinput.input(str(filename), inplace=True):
+                if line.startswith(prefix):
+                    if not matched and userline:
+                        print userline
+                    matched = True
+                else:
+                    print line,
+        except EnvironmentError, e:
+            if e.errno == errno.ENOENT:
+                pass # ignore when file doesn't exist and create it below
+            elif e.errno == errno.EACCES:
+                raise TracError(u'Le fichier des mots de passe ne peut être '
+                                u'mis à jour. Trac a besoin des accés en lecture'
+                                u' et écriture aussi bien sur ce fichier que '
+                                u'sur son dossier parent.')
+            else:
+                raise
+        if not matched and userline:
+            f = open(filename, 'a')
+            try:
+                print >>f, userline
+            finally:
+                f.close()
+        return matched
+
+
+class HtPasswdStore(AbstractPasswordFileStore):
+    """Manages user accounts stored in Apache's htpasswd format.
+
+    To use this implementation add the following configuration section to
+    trac.ini:
+    {{{
+    [account-manager]
+    password_store = HtPasswdStore
+    password_file = /path/to/trac.htpasswd
+    }}}
+    """
+
+    implements(IPasswordStore)
+
+    def config_key(self):
+        return 'htpasswd'
+
+    def prefix(self, user):
+        return user + ':'
+
+    def userline(self, user, password):
+        return self.prefix(user) + htpasswd(password)
+
+    def _check_userline(self, user, password, suffix):
+        return suffix == htpasswd(password, suffix)
+
+    def _get_users(self, filename):
+        f = open(filename)
+        for line in f:
+            user = line.split(':', 1)[0]
+            if user:
+                yield user.decode('utf-8')
+
+
+class HtDigestStore(AbstractPasswordFileStore):
+    """Manages user accounts stored in Apache's htdigest format.
+
+    To use this implementation add the following configuration section to
+    trac.ini:
+    {{{
+    [account-manager]
+    password_store = HtDigestStore
+    password_file = /path/to/trac.htdigest
+    htdigest_realm = TracDigestRealm
+    }}}
+    """
+
+
+    implements(IPasswordStore)
+
+    realm = Option('account-manager', 'htdigest_realm')
+
+    def config_key(self):
+        return 'htdigest'
+
+    def prefix(self, user):
+        return '%s:%s:' % (user, self.realm)
+
+    def userline(self, user, password):
+        return self.prefix(user) + htdigest(user, self.realm, password)
+
+    def _check_userline(self, user, password, suffix):
+        return suffix == htdigest(user, self.realm, password)
+
+    def _get_users(self, filename):
+        _realm = self.realm
+        f = open(filename)
+        for line in f:
+            args = line.split(':')[:2]
+            if len(args) == 2:
+                user, realm = args
+                if realm == _realm and user:
+                    yield user.decode('utf-8')
+
Index: /TracAccountManager/0.10/acct_mgr/http.py
===================================================================
--- /TracAccountManager/0.10/acct_mgr/http.py	(revision 3)
+++ /TracAccountManager/0.10/acct_mgr/http.py	(revision 3)
@@ -0,0 +1,35 @@
+# -*- coding: utf8 -*-
+#
+# Copyright (C) 2005 Matthew Good <trac@matt-good.net>
+#
+# "THE BEER-WARE LICENSE" (Revision 42):
+# <trac@matt-good.net> wrote this file.  As long as you retain this notice you
+# can do whatever you want with this stuff. If we meet some day, and you think
+# this stuff is worth it, you can buy me a beer in return.   Matthew Good
+#
+# Author: Matthew Good <trac@matt-good.net>
+
+from urllib2 import build_opener, HTTPBasicAuthHandler, \
+                    HTTPDigestAuthHandler, HTTPPasswordMgrWithDefaultRealm
+
+from trac.core import *
+from trac.config import Option
+
+from api import IPasswordStore
+
+class HttpAuthStore(Component):
+    implements(IPasswordStore)
+
+    auth_url = Option('account-manager', 'authentication_url')
+
+    def check_password(self, user, password):
+        mgr = HTTPPasswordMgrWithDefaultRealm()
+        mgr.add_password(None, self.auth_url, user, password)
+        try:
+            build_opener(HTTPBasicAuthHandler(mgr),
+                         HTTPDigestAuthHandler(mgr)).open(self.auth_url)
+        except IOError:
+            return False
+        else:
+            return True
+
Index: /TracAccountManager/0.10/acct_mgr/md5crypt.py
===================================================================
--- /TracAccountManager/0.10/acct_mgr/md5crypt.py	(revision 3)
+++ /TracAccountManager/0.10/acct_mgr/md5crypt.py	(revision 3)
@@ -0,0 +1,96 @@
+# -*- coding: utf-8 -*-
+#
+# Based on FreeBSD src/lib/libcrypt/crypt.c 1.2
+# http://www.freebsd.org/cgi/cvsweb.cgi/~checkout~/src/lib/libcrypt/crypt.c?rev=1.2&content-type=text/plain
+
+# Original license:
+# * "THE BEER-WARE LICENSE" (Revision 42):
+# * <phk@login.dknet.dk> wrote this file.  As long as you retain this notice you
+# * can do whatever you want with this stuff. If we meet some day, and you think
+# * this stuff is worth it, you can buy me a beer in return.   Poul-Henning Kamp
+
+# This port adds no further stipulations.  I forfeit any copyright interest.
+
+import md5
+
+def md5crypt(password, salt, magic='$1$'):
+    # /* The password first, since that is what is most unknown */ /* Then our magic string */ /* Then the raw salt */
+    m = md5.new()
+    m.update(password + magic + salt)
+
+    # /* Then just as many characters of the MD5(pw,salt,pw) */
+    mixin = md5.md5(password + salt + password).digest()
+    for i in range(0, len(password)):
+        m.update(mixin[i % 16])
+
+    # /* Then something really weird... */
+    # Also really broken, as far as I can tell.  -m
+    i = len(password)
+    while i:
+        if i & 1:
+            m.update('\x00')
+        else:
+            m.update(password[0])
+        i >>= 1
+
+    final = m.digest()
+
+    # /* and now, just to make sure things don't run too fast */
+    for i in range(1000):
+        m2 = md5.md5()
+        if i & 1:
+            m2.update(password)
+        else:
+            m2.update(final)
+
+        if i % 3:
+            m2.update(salt)
+
+        if i % 7:
+            m2.update(password)
+
+        if i & 1:
+            m2.update(final)
+        else:
+            m2.update(password)
+
+        final = m2.digest()
+
+    # This is the bit that uses to64() in the original code.
+
+    itoa64 = './0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+
+    rearranged = ''
+    for a, b, c in ((0, 6, 12), (1, 7, 13), (2, 8, 14), (3, 9, 15), (4, 10, 5)):
+        v = ord(final[a]) << 16 | ord(final[b]) << 8 | ord(final[c])
+        for i in range(4):
+            rearranged += itoa64[v & 0x3f]; v >>= 6
+
+    v = ord(final[11])
+    for i in range(2):
+        rearranged += itoa64[v & 0x3f]; v >>= 6
+
+    return magic + salt + '$' + rearranged
+
+if __name__ == '__main__':
+
+    def test(clear_password, the_hash):
+        magic, salt = the_hash[1:].split('$')[:2]
+        magic = '$' + magic + '$'
+        return md5crypt(clear_password, salt, magic) == the_hash
+
+    test_cases = (
+        (' ', '$1$yiiZbNIH$YiCsHZjcTkYd31wkgW8JF.'),
+        ('pass', '$1$YeNsbWdH$wvOF8JdqsoiLix754LTW90'),
+        ('____fifteen____', '$1$s9lUWACI$Kk1jtIVVdmT01p0z3b/hw1'),
+        ('____sixteen_____', '$1$dL3xbVZI$kkgqhCanLdxODGq14g/tW1'),
+        ('____seventeen____', '$1$NaH5na7J$j7y8Iss0hcRbu3kzoJs5V.'),
+        ('__________thirty-three___________', '$1$HO7Q6vzJ$yGwp2wbL5D7eOVzOmxpsy.'),
+        ('apache', '$apr1$J.w5a/..$IW9y6DR0oO/ADuhlMF5/X1')
+    )
+
+    for clearpw, hashpw in test_cases:
+        if test(clearpw, hashpw):
+            print '%s: pass' % clearpw
+        else:
+            print '%s: FAIL' % clearpw
Index: /TracAccountManager/0.10/acct_mgr/pwhash.py
===================================================================
--- /TracAccountManager/0.10/acct_mgr/pwhash.py	(revision 3)
+++ /TracAccountManager/0.10/acct_mgr/pwhash.py	(revision 3)
@@ -0,0 +1,101 @@
+# -*- coding: utf8 -*-
+#
+# Copyright (C) 2007 Matthew Good <trac@matt-good.net>
+#
+# "THE BEER-WARE LICENSE" (Revision 42):
+# <trac@matt-good.net> wrote this file.  As long as you retain this notice you
+# can do whatever you want with this stuff. If we meet some day, and you think
+# this stuff is worth it, you can buy me a beer in return.   Matthew Good
+#
+# Author: Matthew Good <trac@matt-good.net>
+
+from binascii import hexlify
+import md5, sha
+
+from trac.core import *
+from trac.config import Option
+
+from md5crypt import md5crypt
+
+class IPasswordHashMethod(Interface):
+    def generate_hash(user, password):
+        pass
+
+    def test_hash(user, password, hash):
+        pass
+
+
+class HtPasswdHashMethod(Component):
+    implements(IPasswordHashMethod)
+
+    def generate_hash(self, user, password):
+        password = password.encode('utf-8')
+        return htpasswd(password)
+
+    def check_hash(self, user, password, hash):
+        password = password.encode('utf-8')
+        return hash == htpasswd(password, hash)
+
+
+class HtDigestHashMethod(Component):
+    implements(IPasswordHashMethod)
+
+    realm = Option('account-manager', 'htdigest_realm')
+
+    def generate_hash(self, user, password):
+        user,password,realm = _encode(user, password, self.realm)
+        return ':'.join([realm, htdigest(user, realm, password)])
+
+    def check_hash(self, user, password, hash):
+        user,password,realm = _encode(user, password, self.realm)
+        return hash == self.generate_hash(user, password)
+
+
+def _encode(*args):
+    return [a.encode('utf-8') for a in args]
+
+# check for the availability of the "crypt" module for checking passwords on
+# Unix-like platforms
+# MD5 is still used when adding/updating passwords
+try:
+    from crypt import crypt
+except ImportError:
+    crypt = None
+
+# os.urandom was added in Python 2.4
+# try to fall back on reading from /dev/urandom on older Python versions
+try:
+    from os import urandom
+except ImportError:
+    from random import randrange
+    def urandom(n):
+        return ''.join([chr(randrange(256)) for _ in xrange(n)])
+
+def salt():
+    s = ''
+    v = long(hexlify(urandom(4)), 16)
+    itoa64 = './0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+    for i in range(8):
+        s += itoa64[v & 0x3f]; v >>= 6
+    return s
+
+def htpasswd(password, salt_=None):
+# TODO need unit test of generating new hash
+    if salt_ is None:
+        salt_ = salt()
+        if crypt is None:
+            salt_ = '$apr1$' + salt_
+    if salt_.startswith('$apr1$'):
+        return md5crypt(password, salt_[6:].split('$')[0], '$apr1$')
+    elif salt_.startswith('{SHA}'):
+        return '{SHA}' + sha.new(password).digest().encode('base64')[:-1]
+    elif crypt is None:
+        # crypt passwords are only supported on Unix-like systems
+        raise NotImplementedError(u'Le module "crypt" n\'est pas disponible '
+                                  u'sur cette plateforme.')
+    else:
+        return crypt(password, salt_)
+
+def htdigest(user, realm, password):
+    p = ':'.join([user, realm, password])
+    return md5.new(p).hexdigest()
Index: /TracAccountManager/0.10/acct_mgr/templates/account.cs
===================================================================
--- /TracAccountManager/0.10/acct_mgr/templates/account.cs	(revision 3)
+++ /TracAccountManager/0.10/acct_mgr/templates/account.cs	(revision 3)
@@ -0,0 +1,78 @@
+<?cs include "header.cs"?>
+<?cs include "macros.cs"?>
+
+<div id="ctxtnav" class="nav"></div>
+
+<div id="content" class="register">
+
+ <h1>Mon Compte</h1>
+
+ <p>
+ Gestion de votre compte utilisateur.
+ </p>
+
+ <?cs if account.error ?>
+ <div class="system-message">
+  <h2>Erreur</h2>
+  <p><?cs var:account.error ?></p>
+ </div>
+ <?cs /if ?>
+
+ <?cs if account.message ?>
+ <p><?cs var:account.message ?></p>
+ <?cs /if ?>
+
+ <h2>Modification du mot de passe</h2>
+ <?cs if account.save_error ?>
+ <div class="system-message">
+  <h2>Erreur</h2>
+  <p><?cs var:account.save_error ?></p>
+ </div>
+ <?cs /if ?>
+
+ <form method="post" action="">
+  <input type="hidden" name="action" value="change_password" />
+  <div>
+   <label for="old_password">Ancien mot de passe :</label>
+   <input type="password" id="old_password" name="old_password"
+          class="textwidget" size="20" />
+  </div>
+  <div>
+   <label for="password">Nouveau mot de passe :</label>
+   <input type="password" id="password" name="password" class="textwidget"
+          size="20" />
+  </div>
+  <div>
+   <label for="password_confirm">Confirmation du mot de passe :</label>
+   <input type="password" id="password_confirm" name="password_confirm"
+          class="textwidget" size="20" />
+  </div>
+  <input type="submit" value="Modifier le mot de passe" />
+ </form>
+
+ <?cs if:delete_enabled ?>
+ <hr />
+
+ <h2>Suppression de compte</h2>
+ <?cs if account.delete_error ?>
+ <div class="system-message">
+  <h2>Erreur</h2>
+  <p><?cs var:account.delete_error ?></p>
+ </div>
+ <?cs /if ?>
+
+ <form method="post" action=""
+       onsubmit="return confirm('Etes vous sûre de vouloir effacer votre compte ?');">
+  <input type="hidden" name="action" value="delete" />
+  <div>
+   <label for="password">Mot de passe:</label>
+   <input type="password" id="password" name="password" class="textwidget"
+          size="20" />
+  </div>
+  <input type="submit" value="Effacer le compte" />
+ </form>
+ <?cs /if ?>
+
+</div>
+
+<?cs include:"footer.cs"?>
Index: /TracAccountManager/0.10/acct_mgr/templates/admin_accountsconfig.cs
===================================================================
--- /TracAccountManager/0.10/acct_mgr/templates/admin_accountsconfig.cs	(revision 3)
+++ /TracAccountManager/0.10/acct_mgr/templates/admin_accountsconfig.cs	(revision 3)
@@ -0,0 +1,27 @@
+<h2>Comptes: Configuration</h2>
+
+<form id="accountsconfig" class="mod" method="post">
+<?cs each:section = sections ?>
+    <fieldset>
+        <legend>
+            <label>
+                <input type="radio" name="selected" value="<?cs var:section.classname ?>"
+                       <?cs if:section.selected ?>checked="checked"<?cs /if ?> />
+                <?cs var:section.name ?>
+            </label>
+        </legend>
+
+        <?cs each:option = section.options ?>
+            <div class="field">
+                <label><?cs alt:translation[option.label] ?><?cs var:option.label ?><?cs /alt ?>:
+                    <input type="text" name="<?cs var:option.name ?>" value="<?cs var:option.value ?>"
+                           class="textwidget" />
+                </label>
+            </div>
+        <?cs /each ?>
+    </fieldset>
+<?cs /each ?>
+<div class="buttons">
+    <input type="submit" name="save" value="Sauver" />
+</div>
+</form>
Index: /TracAccountManager/0.10/acct_mgr/templates/admin_users.cs
===================================================================
--- /TracAccountManager/0.10/acct_mgr/templates/admin_users.cs	(revision 3)
+++ /TracAccountManager/0.10/acct_mgr/templates/admin_users.cs	(revision 3)
@@ -0,0 +1,67 @@
+<h2>Gestion des comptes utilisateurs</h2>
+
+<?cs if:create_enabled ?>
+<form id="addaccount" class="addnew" method="post">
+ <fieldset>
+  <?cs if registration.error ?>
+  <div class="system-message"><p><?cs var:registration.error ?></p></div>
+  <?cs /if ?>
+
+  <legend>Ajouter un compte :</legend>
+  <div class="field">
+   <label>Nom d'utilisateur : <input type="text" name="user" class="textwidget" /></label>
+  </div>
+  <div class="field">
+   <label>Mot de passe : <input type="password" name="password" class="textwidget" /></label>
+  </div>
+  <div class="field">
+   <label>Confirmation du mot de passe : <input type="password" name="password_confirm" class="textwidget" /></label>
+  </div>
+  <div class="field">
+   <label>Nom: <input type="text" name="name" class="textwidget" /></label>
+  </div>
+  <div class="field">
+   <label>Courriel: <input type="text" name="email" class="textwidget" /></label>
+  </div>
+  <p class="help">Ajouter un nouveau compte utilisateur.</p>
+  <div class="buttons">
+   <input type="submit" name="add" value=" Ajouter ">
+  </div>
+ </fieldset>
+</form>
+<?cs /if ?>
+
+<?cs if:!listing_enabled ?>
+<div class="system-message">
+    <p>Cette espace de stockage ne supporte pas le listage des utilisateurs</p>
+</div>
+<?cs else ?>
+<form method="post">
+ <?cs if:deletion_error ?><div class="system-message"><p><?cs var:deletion_error ?></p></div><?cs /if ?>
+ <table class="listing" id="accountlist">
+  <thead>
+   <tr>
+    <?cs if:delete_enabled ?><th class="sel">&nbsp;</th><?cs /if ?>
+    <th>Compte</th><th>Nom</th><th>Courriel</th><th>Derni&egrave;re connexion</th>
+   </tr>
+  </thead><tbody><?cs
+  each:account = accounts ?>
+   <tr>
+    <?cs if:delete_enabled ?>
+     <td><input type="checkbox" name="sel" value="<?cs var:account.username ?>" /></td>
+    <?cs /if ?>
+    <td><?cs var:account.username ?></td>
+    <td><?cs var:account.name ?></td>
+    <td><?cs var:account.email ?></td>
+    <td><?cs var:account.last_visit ?></td>
+   </tr><?cs
+  /each ?></tbody>
+ </table>
+ <?cs if:delete_enabled ?>
+ <div class="buttons">
+  <input type="submit" name="remove" value="Supprimer les comptes s&eacute;lectionn&eacute;s" />
+ </div>
+ <?cs /if ?>
+</form>
+<?cs /if ?>
+
Index: /TracAccountManager/0.10/acct_mgr/templates/login.cs
===================================================================
--- /TracAccountManager/0.10/acct_mgr/templates/login.cs	(revision 3)
+++ /TracAccountManager/0.10/acct_mgr/templates/login.cs	(revision 3)
@@ -0,0 +1,36 @@
+<?cs include "header.cs"?>
+<?cs include "macros.cs"?>
+
+<div id="ctxtnav" class="nav"></div>
+
+<div id="content" class="login">
+
+ <h1>Connexion</h1>
+
+ <?cs if login.error ?>
+ <div class="system-message">
+  <h2>Erreur</h2>
+  <p><?cs var:login.error ?></p>
+ </div>
+ <?cs /if ?>
+
+ <form method="post" action="">
+  <input type="hidden" name="referer" value="<?cs var:referer ?>" />
+  <div>
+   <label for="user">Nom d'utilisateur :</label>
+   <input type="text" id="user" name="user" class="textwidget" size="20" />
+  </div>
+  <div>
+   <label for="password">Mot de passe :</label>
+   <input type="password" id="password" name="password" class="textwidget" size="20" />
+  </div>
+  <input type="submit" value="Se connecter" />
+
+  <?cs if trac.href.reset_password ?>
+  <p><a href="<?cs var:trac.href.reset_password ?>">Mot de passe oubli&eacute; ?</a></p>
+  <?cs /if ?>
+ </form>
+
+</div>
+
+<?cs include:"footer.cs"?>
Index: /TracAccountManager/0.10/acct_mgr/templates/register.cs
===================================================================
--- /TracAccountManager/0.10/acct_mgr/templates/register.cs	(revision 3)
+++ /TracAccountManager/0.10/acct_mgr/templates/register.cs	(revision 3)
@@ -0,0 +1,60 @@
+<?cs include "header.cs"?>
+<?cs include "macros.cs"?>
+
+<div id="ctxtnav" class="nav"></div>
+
+<div id="content" class="register">
+
+ <h1>Cr&eacute;er un compte</h1>
+
+ <?cs if registration.error ?>
+ <div class="system-message">
+  <h2>Erreur</h2>
+  <p><?cs var:registration.error ?></p>
+ </div>
+ <?cs /if ?>
+
+ <form method="post" action="">
+  <fieldset>
+   <legend>Requis</legend>
+   <div>
+    <input type="hidden" name="action" value="create" />
+    <label>Nom d'utilisateur :
+     <input type="text" name="user" class="textwidget" size="20" />
+    </label>
+   </div>
+   <div>
+    <label>Mot de passe :
+     <input type="password" name="password" class="textwidget" size="20" />
+    </label>
+   </div>
+   <div>
+    <label>Confirmation du mot de passe :
+     <input type="password" name="password_confirm"
+            class="textwidget" size="20" />
+    </label>
+   </div>
+  </fieldset>
+  <fieldset>
+   <legend>Facultatif</legend>
+   <div>
+    <label>Nom :
+     <input type="text" name="name" class="textwidget" size="20" />
+    </label>
+   </div>
+   <div>
+    <label>Courriel :
+     <input type="text" name="email" class="textwidget" size="20" />
+    </label>
+    <?cs if reset_password_enabled ?>
+    <p>Fournir votre courriel vous autorisera &agrave; r&eacute;-initialiser
+    votre mot de passe en cas d'oubli.</p>
+    <?cs /if ?>
+   </div>
+  </fieldset>
+  <input type="submit" value="Cr&eacute;er le compte" />
+ </form>
+
+</div>
+
+<?cs include:"footer.cs"?>
Index: /TracAccountManager/0.10/acct_mgr/templates/reset_password.cs
===================================================================
--- /TracAccountManager/0.10/acct_mgr/templates/reset_password.cs	(revision 3)
+++ /TracAccountManager/0.10/acct_mgr/templates/reset_password.cs	(revision 3)
@@ -0,0 +1,57 @@
+<?cs include "header.cs"?>
+<?cs include "macros.cs"?>
+
+<div id="ctxtnav" class="nav"></div>
+
+<div id="content" class="register">
+
+ <h1>R&eacute;g&eacute;n&eacute;ration du mot de passe</h1>
+
+ <?cs if reset.logged_in ?>
+ <div class="system-message">
+  <h2>D&eacute;j&agrave; connect&eacute;</h2>
+  <p>
+   Vous &ecirc;tes d&eacute;j&agrave; connect&eacute;. Si vous avez besoin de changer votre mot de passe,
+   vous pouvez utiliser la page <a href="<?cs var:account_href ?>">Mon Compte</a>.
+  </p>
+ </div>
+ <?cs elif reset.sent_to_email ?>
+ <p>Un nouveau mot de passe vous a &eacute;t&eacute; envoy&eacute; &agrave; l'adresse <?cs var:reset.sent_to_email ?>.</p>
+ <?cs else ?>
+ <p>
+ Si vous avez oubli&eacute; votre mot de passe, entrez ci-dessous votre nom d'utilisateur et votre courriel
+ et un nouveau mot de passe vous sera envoy&eacute;.
+ </p>
+
+ <?cs if reset.error ?>
+ <div class="system-message">
+  <h2>Erreur</h2>
+  <p><?cs var:reset.error ?></p>
+ </div>
+ <?cs /if ?>
+
+ <?cs if reset.message ?>
+ <p><?cs var:reset.message ?></p>
+ <?cs /if ?>
+
+ <form method="post" action="">
+  <div>
+   <label>
+    Nom d'utilisateur :
+    <input type="text" name="username" class="textwidget" size="20" />
+   </label>
+  </div>
+  <div>
+   <label>
+    Courriel :
+    <input type="text" name="email" class="textwidget" size="20" />
+   </label>
+  </div>
+  <input type="submit" value="R&eacute;g&eacute;n&eacute;rer le mot de passe" />
+ </form>
+ <?cs /if ?>
+
+</div>
+
+<?cs include:"footer.cs"?>
+
Index: /TracAccountManager/0.10/acct_mgr/templates/reset_password_email.cs
===================================================================
--- /TracAccountManager/0.10/acct_mgr/templates/reset_password_email.cs	(revision 3)
+++ /TracAccountManager/0.10/acct_mgr/templates/reset_password_email.cs	(revision 3)
@@ -0,0 +1,12 @@
+Votre mot de passe Trac a &eacute;t&eacute; r&eacute;g&eacute;n&eacute;r&eacute;.
+
+Voici les informations de votre compte :
+
+Lien de connexion : <<?cs var:login.link ?>>
+Nom d'utilisateur : <?cs var:account.username ?>
+Mot de passe : <?cs var:account.password ?>
+
+--
+<?cs var:project.name ?> <<?cs var:project.url ?>>
+<?cs var:project.descr ?>
+
Index: /TracAccountManager/0.10/acct_mgr/tests/__init__.py
===================================================================
--- /TracAccountManager/0.10/acct_mgr/tests/__init__.py	(revision 3)
+++ /TracAccountManager/0.10/acct_mgr/tests/__init__.py	(revision 3)
@@ -0,0 +1,23 @@
+# -*- coding: utf-8 -*-
+#
+# Copyright (C) 2005 Matthew Good <trac@matt-good.net>
+#
+# "THE BEER-WARE LICENSE" (Revision 42):
+# <trac@matt-good.net> wrote this file.  As long as you retain this notice you
+# can do whatever you want with this stuff. If we meet some day, and you think
+# this stuff is worth it, you can buy me a beer in return.   Matthew Good
+#
+# Author: Matthew Good <trac@matt-good.net>
+
+import doctest
+import unittest
+
+def suite():
+    from acct_mgr.tests import htfile, db
+    suite = unittest.TestSuite()
+    suite.addTest(htfile.suite())
+    suite.addTest(db.suite())
+    return suite
+
+if __name__ == '__main__':
+    unittest.main(defaultTest='suite')
Index: /TracAccountManager/0.10/acct_mgr/tests/db.py
===================================================================
--- /TracAccountManager/0.10/acct_mgr/tests/db.py	(revision 3)
+++ /TracAccountManager/0.10/acct_mgr/tests/db.py	(revision 3)
@@ -0,0 +1,100 @@
+# -*- coding: utf-8 -*-
+#
+# Copyright (C) 2007 Matthew Good <trac@matt-good.net>
+#
+# "THE BEER-WARE LICENSE" (Revision 42):
+# <trac@matt-good.net> wrote this file.  As long as you retain this notice you
+# can do whatever you want with this stuff. If we meet some day, and you think
+# this stuff is worth it, you can buy me a beer in return.   Matthew Good
+#
+# Author: Matthew Good <trac@matt-good.net>
+
+import os.path
+import shutil
+import tempfile
+import unittest
+
+from trac.test import EnvironmentStub, Mock
+
+from acct_mgr.db import SessionStore
+
+class _BaseTestCase(unittest.TestCase):
+    def setUp(self):
+        #self.basedir = os.path.realpath(tempfile.mkdtemp())
+        self.env = EnvironmentStub()
+        self.env.config.set('account-manager', 'password_store',
+                            'SessionStore')
+        self.store = SessionStore(self.env)
+        #self.env.path = os.path.join(self.basedir, 'trac-tempenv')
+        #os.mkdir(self.env.path)
+
+    def test_get_users(self):
+        db = self.env.get_db_cnx()
+        cursor = db.cursor()
+        cursor.executemany("INSERT INTO session_attribute "
+                       "(sid,authenticated,name,value) "
+                       "VALUES (%s,1,'password',%s)",
+                       [('a', 'a'),
+                        ('b', 'b'),
+                        ('c', 'c')])
+        self.assertEqual(['a', 'b', 'c'], list(self.store.get_users()))
+
+    def test_has_user(self):
+        db = self.env.get_db_cnx()
+        cursor = db.cursor()
+        cursor.execute("INSERT INTO session_attribute "
+                       "(sid,authenticated,name,value) "
+                       "VALUES (%s,1,'password',%s)",
+                       ('bar', 'bar'))
+
+        self.assertFalse(self.store.has_user('foo'))
+        self.assertTrue(self.store.has_user('bar'))
+
+    def test_create_user(self):
+        self.assertFalse(self.store.has_user('foo'))
+        self.store.set_password('foo', 'password')
+        self.assertTrue(self.store.has_user('foo'))
+ 
+    def test_update_password(self):
+        self.store.set_password('foo', 'pass1')
+        self.assertFalse(self.store.check_password('foo', 'pass2'))
+        self.store.set_password('foo', 'pass2')
+        self.assertTrue(self.store.check_password('foo', 'pass2'))
+
+    def test_delete_user(self):
+        self.store.set_password('foo', 'password')
+        self.assertTrue(self.store.has_user('foo'))
+        self.assertTrue(self.store.delete_user('foo'))
+        self.assertFalse(self.store.has_user('foo'))
+
+    def test_delete_nonexistant_user(self):
+        self.assertFalse(self.store.has_user('foo'))
+        self.assertFalse(self.store.delete_user('foo'))
+
+
+class HtDigestTestCase(_BaseTestCase):
+    def setUp(self):
+        _BaseTestCase.setUp(self)
+        self.env.config.set('account-manager', 'hash_method',
+                            'HtDigestHashMethod')
+        self.env.config.set('account-manager', 'htdigest_realm',
+                            'TestRealm')
+
+
+class HtPasswdTestCase(_BaseTestCase):
+    def setUp(self):
+        _BaseTestCase.setUp(self)
+        self.env.config.set('account-manager', 'hash_method',
+                            'HtPasswdHashMethod')
+
+
+def suite():
+    suite = unittest.TestSuite()
+    suite.addTest(unittest.makeSuite(HtDigestTestCase, 'test'))
+    suite.addTest(unittest.makeSuite(HtPasswdTestCase, 'test'))
+    return suite
+
+if __name__ == '__main__':
+    unittest.main(defaultTest='suite')
+
+
Index: /TracAccountManager/0.10/acct_mgr/tests/htfile.py
===================================================================
--- /TracAccountManager/0.10/acct_mgr/tests/htfile.py	(revision 3)
+++ /TracAccountManager/0.10/acct_mgr/tests/htfile.py	(revision 3)
@@ -0,0 +1,97 @@
+# -*- coding: utf-8 -*-
+#
+# Copyright (C) 2005 Matthew Good <trac@matt-good.net>
+#
+# "THE BEER-WARE LICENSE" (Revision 42):
+# <trac@matt-good.net> wrote this file.  As long as you retain this notice you
+# can do whatever you want with this stuff. If we meet some day, and you think
+# this stuff is worth it, you can buy me a beer in return.   Matthew Good
+#
+# Author: Matthew Good <trac@matt-good.net>
+
+import os.path
+import shutil
+import tempfile
+import unittest
+
+from trac.test import EnvironmentStub, Mock
+
+from acct_mgr.htfile import HtDigestStore, HtPasswdStore
+
+class _BaseTestCase(unittest.TestCase):
+    def setUp(self):
+        self.basedir = os.path.realpath(tempfile.mkdtemp())
+        self.env = EnvironmentStub()
+        self.env.path = os.path.join(self.basedir, 'trac-tempenv')
+        os.mkdir(self.env.path)
+
+    def tearDown(self):
+        shutil.rmtree(self.basedir)
+
+    def _create_file(self, *path, **kw):
+        filename = os.path.join(self.basedir, *path)
+        dirname = os.path.dirname(filename)
+        if not os.path.exists(dirname):
+            os.makedirs(dirname)
+        fd = file(filename, 'w')
+        content = kw.get('content')
+        if content is not None:
+            fd.write(content)
+        fd.close()
+        return filename
+
+    def _do_password_test(self, filename, content):
+        filename = self._create_file(filename, content=content)
+        self.env.config.set('account-manager', 'password_file', filename)
+        self.assertTrue(self.store.check_password('user', 'password'))
+
+
+class HtDigestTestCase(_BaseTestCase):
+    def setUp(self):
+        _BaseTestCase.setUp(self)
+        self.env.config.set('account-manager', 'password_store',
+                            'HtDigestStore')
+        self.env.config.set('account-manager', 'htdigest_realm',
+                            'TestRealm')
+        self.store = HtDigestStore(self.env)
+
+    def test_userline(self):
+        self.assertEqual(self.store.userline('user', 'password'),
+                         'user:TestRealm:752b304cc7cf011d69ee9b79e2cd0866')
+
+    def test_file(self):
+        self._do_password_test('test_file', 
+                               'user:TestRealm:752b304cc7cf011d69ee9b79e2cd0866')
+
+class HtPasswdTestCase(_BaseTestCase):
+    def setUp(self):
+        _BaseTestCase.setUp(self)
+        self.env.config.set('account-manager', 'password_store',
+                            'HtPasswdStore')
+        self.store = HtPasswdStore(self.env)
+
+    def test_md5(self):
+        self._do_password_test('test_md5',
+                               'user:$apr1$xW/09...$fb150dT95SoL1HwXtHS/I0\n')
+
+    def test_crypt(self):
+        self._do_password_test('test_crypt', 'user:QdQ/xnl2v877c\n')
+
+    def test_sha(self):
+        self._do_password_test('test_sha',
+                               'user:{SHA}W6ph5Mm5Pz8GgiULbPgzG37mj9g=\n')
+
+    def test_no_trailing_newline(self):
+        self._do_password_test('test_no_trailing_newline',
+                               'user:$apr1$xW/09...$fb150dT95SoL1HwXtHS/I0')
+
+
+def suite():
+    suite = unittest.TestSuite()
+    suite.addTest(unittest.makeSuite(HtDigestTestCase, 'test'))
+    suite.addTest(unittest.makeSuite(HtPasswdTestCase, 'test'))
+    return suite
+
+if __name__ == '__main__':
+    unittest.main(defaultTest='suite')
+
Index: /TracAccountManager/0.10/acct_mgr/web_ui.py
===================================================================
--- /TracAccountManager/0.10/acct_mgr/web_ui.py	(revision 3)
+++ /TracAccountManager/0.10/acct_mgr/web_ui.py	(revision 3)
@@ -0,0 +1,416 @@
+# -*- coding: utf-8 -*-
+#
+# Copyright (C) 2005 Matthew Good <trac@matt-good.net>
+#
+# "THE BEER-WARE LICENSE" (Revision 42):
+# <trac@matt-good.net> wrote this file.  As long as you retain this notice you
+# can do whatever you want with this stuff. If we meet some day, and you think
+# this stuff is worth it, you can buy me a beer in return.   Matthew Good
+#
+# Author: Matthew Good <trac@matt-good.net>
+
+from __future__ import generators
+
+import random
+import string
+
+from trac import perm, util
+from trac.core import *
+from trac.config import IntOption
+from trac.notification import NotificationSystem, NotifyEmail
+from trac.web import auth
+from trac.web.api import IAuthenticator
+from trac.web.main import IRequestHandler
+from trac.web.chrome import INavigationContributor, ITemplateProvider
+from trac.util import Markup
+
+from api import AccountManager
+
+def _create_user(req, env, check_permissions=True):
+    mgr = AccountManager(env)
+
+    user = req.args.get('user')
+    if not user:
+        raise TracError(u'Le nom d\'utilisateur ne peut être vide.')
+
+    if mgr.has_user(user):
+        raise TracError(u'Un autre coompte avec ce nom existe déjà.')
+
+    if check_permissions:
+        # disallow registration of accounts which have existing permissions
+        permission_system = perm.PermissionSystem(env)
+        if permission_system.get_user_permissions(user) != \
+           permission_system.get_user_permissions('authenticated'):
+            raise TracError(u'Un autre coompte avec ce nom existe déjà.')
+
+    password = req.args.get('password')
+    if not password:
+        raise TracError(u'Le mot de passe ne peut pas être vide.')
+
+    if password != req.args.get('password_confirm'):
+        raise TracError(u'Le mot de passe doit correspondre.')
+
+    mgr.set_password(user, password)
+
+    db = env.get_db_cnx()
+    cursor = db.cursor()
+    cursor.execute("SELECT count(*) FROM session "
+                   "WHERE sid=%s AND authenticated=1",
+                   (user,))
+    exists, = cursor.fetchone()
+    if not exists:
+        cursor.execute("INSERT INTO session "
+                       "(sid, authenticated, last_visit) "
+                       "VALUES (%s, 1, 0)",
+                       (user,))
+
+    for key in ('name', 'email'):
+        value = req.args.get(key)
+        if not value:
+            continue
+        cursor.execute("UPDATE session_attribute SET value=%s "
+                       "WHERE name=%s AND sid=%s AND authenticated=1",
+                       (value, key, user))
+        if not cursor.rowcount:
+            cursor.execute("INSERT INTO session_attribute "
+                           "(sid,authenticated,name,value) "
+                           "VALUES (%s,1,%s,%s)",
+                           (user, key, value))
+    db.commit()
+
+
+class PasswordResetNotification(NotifyEmail):
+    template_name = 'reset_password_email.cs'
+    _username = None
+
+    def get_recipients(self, resid):
+        return ([resid],[])
+
+    def get_smtp_address(self, addr):
+        """Overrides `get_smtp_address` in order to prevent CCing users
+        other than the user whose password is being reset.
+        """
+        if addr == self._username:
+            return NotifyEmail.get_smtp_address(self, addr)
+        else:
+            return None
+
+    def notify(self, username, password):
+        # save the username for use in `get_smtp_address`
+        self._username = username
+        self.hdf['account.username'] = username
+        self.hdf['account.password'] = password
+        self.hdf['login.link'] = self.env.abs_href.login()
+
+        projname = self.config.get('project', 'name')
+        subject = u'[%s] Ré-initialisation du mot de passe pour l\'utilisateur: %s' % (projname, username)
+
+        NotifyEmail.notify(self, username, subject)
+
+
+class AccountModule(Component):
+    """Allows users to change their password, reset their password if they've
+    forgotten it, or delete their account.  The settings for the AccountManager
+    module must be set in trac.ini in order to use this.
+    """
+
+    implements(INavigationContributor, IRequestHandler, ITemplateProvider)
+
+    _password_chars = string.ascii_letters + string.digits
+    password_length = IntOption('account-manager', 'generated_password_length', 8,
+                                u'Longueur des mots de passe aléatoirement générés,'
+                                u' créés à l\'occasion de la ré-initialisation du '
+                                u'mot de passe d\'un compte.')
+
+    def __init__(self):
+        self._write_check(log=True)
+
+    def _write_check(self, log=False):
+        writable = AccountManager(self.env).supports('set_password')
+        if not writable and log:
+            self.log.warn('AccountModule is disabled because the password '
+                          'store does not support writing.')
+        return writable
+
+    #INavigationContributor methods
+    def get_active_navigation_item(self, req):
+        if req.path_info == '/account':
+            return 'account'
+        elif req.path_info == '/reset_password':
+            return 'reset_password'
+
+    def get_navigation_items(self, req):
+        if not self._write_check():
+            return
+        if req.authname != 'anonymous':
+            yield 'metanav', 'account', Markup(u'<a href="%s">Mon Compte</a>',
+                                               (req.href.account()))
+        elif self.reset_password_enabled and not LoginModule(self.env).enabled:
+            yield 'metanav', 'reset_password', Markup(u'<a href="%s">Mot de passe oublié ?</a>',
+                                                      (req.href.reset_password()))
+
+    # IRequestHandler methods
+    def match_request(self, req):
+        return (req.path_info in ('/account', '/reset_password')
+                and self._write_check(log=True))
+
+    def process_request(self, req):
+        if req.path_info == '/account':
+            self._do_account(req)
+            return 'account.cs', None
+        elif req.path_info == '/reset_password':
+            self._do_reset_password(req)
+            return 'reset_password.cs', None
+
+    def reset_password_enabled(self):
+        return (self.env.is_component_enabled(AccountModule)
+                and NotificationSystem(self.env).smtp_enabled
+                and self._write_check())
+    reset_password_enabled = property(reset_password_enabled)
+
+    def _do_account(self, req):
+        if req.authname == 'anonymous':
+            req.redirect(self.env.href.wiki())
+        action = req.args.get('action')
+        delete_enabled = AccountManager(self.env).supports('delete_user')
+        req.hdf['delete_enabled'] = delete_enabled
+        if req.method == 'POST':
+            if action == 'change_password':
+                self._do_change_password(req)
+            elif action == 'delete':
+                self._do_delete(req)
+
+    def _do_reset_password(self, req):
+        if req.authname != 'anonymous':
+            req.hdf['reset.logged_in'] = True
+            req.hdf['account_href'] = req.href.account()
+            return
+        if req.method == 'POST':
+            username = req.args.get('username')
+            email = req.args.get('email')
+            if not username:
+                req.hdf['reset.error'] = u'Nom d\'utilisateur requis'
+                return
+            if not email:
+                req.hdf['reset.error'] = u'Courriel requis'
+                return
+
+            notifier = PasswordResetNotification(self.env)
+
+            if email != notifier.email_map.get(username):
+                req.hdf['reset.error'] = u'Le nom d\'utilisateur et le courriel ' \
+                                         u'ne correspondent pas à un compte connu.'
+                return
+
+            new_password = self._random_password()
+            notifier.notify(username, new_password)
+            AccountManager(self.env).set_password(username, new_password)
+            req.hdf['reset.sent_to_email'] = email
+
+    def _random_password(self):
+        return ''.join([random.choice(self._password_chars)
+                        for _ in xrange(self.password_length)])
+
+    def _do_change_password(self, req):
+        user = req.authname
+        mgr = AccountManager(self.env)
+        old_password = req.args.get('old_password')
+        if not old_password:
+            req.hdf['account.save_error'] = u'L\'ancien mot de passe ne peut pas être vide.'
+            return
+        if not mgr.check_password(user, old_password):
+            req.hdf['account.save_error'] = u'L\'ancien mot de passe n\'est pas correct.'
+            return
+
+        password = req.args.get('password')
+        if not password:
+            req.hdf['account.save_error'] = u'Le mot de passe ne peut pas être vide.'
+            return
+
+        if password != req.args.get('password_confirm'):
+            req.hdf['account.save_error'] = u'Les mots de passe doivent correspondre.'
+            return
+
+        mgr.set_password(user, password)
+        req.hdf['account.message'] = u'Mot de passe mis à jour avec succés.'
+
+    def _do_delete(self, req):
+        user = req.authname
+        mgr = AccountManager(self.env)
+        password = req.args.get('password')
+        if not password:
+            req.hdf['account.delete_error'] = u'Le mot de passe ne peut pas être vide.'
+            return
+        if not mgr.check_password(user, password):
+            req.hdf['account.delete_error'] = u'Le mot de passe n\'est pas correct.'
+            return
+
+        mgr.delete_user(user)
+        req.redirect(self.env.href.logout())
+
+    # ITemplateProvider
+
+    def get_htdocs_dirs(self):
+        """Return the absolute path of a directory containing additional
+        static resources (such as images, style sheets, etc).
+        """
+        return []
+
+    def get_templates_dirs(self):
+        """Return the absolute path of the directory containing the provided
+        ClearSilver templates.
+        """
+        from pkg_resources import resource_filename
+        return [resource_filename(__name__, 'templates')]
+
+
+class RegistrationModule(Component):
+    """Provides users the ability to register a new account.
+    Requires configuration of the AccountManager module in trac.ini.
+    """
+
+    implements(INavigationContributor, IRequestHandler, ITemplateProvider)
+
+    def __init__(self):
+        self._enable_check(log=True)
+
+    def _enable_check(self, log=False):
+        writable = AccountManager(self.env).supports('set_password')
+        ignore_case = auth.LoginModule(self.env).ignore_case
+        if log:
+            if not writable:
+                self.log.warn('RegistrationModule is disabled because the '
+                              'password store does not support writing.')
+            if ignore_case:
+                self.log.warn('RegistrationModule is disabled because '
+                              'ignore_auth_case is enabled in trac.ini.  '
+                              'This setting needs disabled to support '
+                              'registration.')
+        return writable and not ignore_case
+
+    #INavigationContributor methods
+
+    def get_active_navigation_item(self, req):
+        return 'register'
+
+    def get_navigation_items(self, req):
+        if not self._enable_check():
+            return
+        if req.authname == 'anonymous':
+            yield 'metanav', 'register', Markup(u'<a href="%s">S\'enregistrer</a>',
+                                                (self.env.href.register()))
+
+    # IRequestHandler methods
+
+    def match_request(self, req):
+        return req.path_info == '/register' and self._enable_check(log=True)
+
+    def process_request(self, req):
+        if req.authname != 'anonymous':
+            req.redirect(self.env.href.account())
+        action = req.args.get('action')
+        if req.method == 'POST' and action == 'create':
+            try:
+                _create_user(req, self.env)
+            except TracError, e:
+                req.hdf['registration.error'] = e.message
+            else:
+                req.redirect(self.env.href.login())
+        req.hdf['reset_password_enabled'] = \
+            (self.env.is_component_enabled(AccountModule)
+             and NotificationSystem(self.env).smtp_enabled)
+
+        return 'register.cs', None
+
+
+    # ITemplateProvider
+
+    def get_htdocs_dirs(self):
+        """Return the absolute path of a directory containing additional
+        static resources (such as images, style sheets, etc).
+        """
+        return []
+
+    def get_templates_dirs(self):
+        """Return the absolute path of the directory containing the provided
+        ClearSilver templates.
+        """
+        from pkg_resources import resource_filename
+        return [resource_filename(__name__, 'templates')]
+
+
+def if_enabled(func):
+    def wrap(self, *args, **kwds):
+        if not self.enabled:
+            return None
+        return func(self, *args, **kwds)
+    return wrap
+
+
+class LoginModule(auth.LoginModule):
+
+    implements(ITemplateProvider)
+
+    def authenticate(self, req):
+        if req.method == 'POST' and req.path_info.startswith('/login'):
+            req.environ['REMOTE_USER'] = self._remote_user(req)
+        return auth.LoginModule.authenticate(self, req)
+    authenticate = if_enabled(authenticate)
+
+    match_request = if_enabled(auth.LoginModule.match_request)
+
+    def process_request(self, req):
+        if req.path_info.startswith('/login') and req.authname == 'anonymous':
+            req.hdf['referer'] = self._referer(req)
+            if AccountModule(self.env).reset_password_enabled:
+                req.hdf['trac.href.reset_password'] = req.href.reset_password()
+            if req.method == 'POST':
+                req.hdf['login.error'] = u'Utilisateur ou mot de passe invalide'
+            return 'login.cs', None
+        return auth.LoginModule.process_request(self, req)
+
+    def _do_login(self, req):
+        if not req.remote_user:
+            req.redirect(self.env.abs_href())
+        return auth.LoginModule._do_login(self, req)
+
+    def _remote_user(self, req):
+        user = req.args.get('user')
+        password = req.args.get('password')
+        if not user or not password:
+            return None
+        if AccountManager(self.env).check_password(user, password):
+            return user
+        return None
+
+    def _redirect_back(self, req):
+        """Redirect the user back to the URL she came from."""
+        referer = self._referer(req)
+        if referer and not referer.startswith(req.base_url):
+            # don't redirect to external sites
+            referer = None
+        req.redirect(referer or self.env.abs_href())
+
+    def _referer(self, req):
+        return req.args.get('referer') or req.get_header('Referer')
+
+    def enabled(self):
+        # Users should disable the built-in authentication to use this one
+        return not self.env.is_component_enabled(auth.LoginModule)
+    enabled = property(enabled)
+
+    # ITemplateProvider
+
+    def get_htdocs_dirs(self):
+        """Return the absolute path of a directory containing additional
+        static resources (such as images, style sheets, etc).
+        """
+        return []
+
+    def get_templates_dirs(self):
+        """Return the absolute path of the directory containing the provided
+        ClearSilver templates.
+        """
+        from pkg_resources import resource_filename
+        return [resource_filename(__name__, 'templates')]
+
Index: /TracAccountManager/0.10/contrib/sessionstore_convert.py
===================================================================
--- /TracAccountManager/0.10/contrib/sessionstore_convert.py	(revision 3)
+++ /TracAccountManager/0.10/contrib/sessionstore_convert.py	(revision 3)
@@ -0,0 +1,36 @@
+import os
+import sys
+
+from trac.env import Environment
+from acct_mgr.api import AccountManager
+from acct_mgr.htfile import HtPasswdStore, HtDigestStore
+from acct_mgr.pwhash import HtPasswdHashMethod, HtDigestHashMethod
+
+env = Environment(sys.argv[1])
+
+store = AccountManager(env).password_store
+if isinstance(store, HtPasswdStore):
+    env.config.set('account-manager', 'hash_method', 'HtPasswdHashMethod')
+    prefix = ''
+elif isinstance(store, HtDigestStore):
+    env.config.set('account-manager', 'hash_method', 'HtDigestHashMethod')
+    prefix = store.realm + ':'
+else:
+    print >>sys.stderr, 'Unsupported password store:', store.__class__.__name__
+    sys.exit(1)
+
+password_file = os.path.join(env.path, env.config.get('account-manager',
+                                                      'password_file'))
+hashes = [line.strip().split(':', 1) for line in open(password_file)]
+hashes = [(u,p) for u,p in hashes if p.startswith(prefix)]
+if hashes:
+    db = env.get_db_cnx()
+    cursor = db.cursor()
+    cursor.executemany("INSERT INTO session_attribute "
+                       "(sid,authenticated,name,value) "
+                       "VALUES (%s,1,'password',%s)",
+                       hashes)
+    db.commit()
+
+env.config.set('account-manager', 'password_store', 'SessionStore')
+env.config.save()
Index: /TracAccountManager/0.10/setup.cfg
===================================================================
--- /TracAccountManager/0.10/setup.cfg	(revision 3)
+++ /TracAccountManager/0.10/setup.cfg	(revision 3)
@@ -0,0 +1,4 @@
+[egg_info]
+tag_build = dev
+tag_svn_revision = true
+
Index: /TracAccountManager/0.10/setup.py
===================================================================
--- /TracAccountManager/0.10/setup.py	(revision 3)
+++ /TracAccountManager/0.10/setup.py	(revision 3)
@@ -0,0 +1,40 @@
+#!/usr/bin/env python
+
+from setuptools import setup
+
+setup(
+    name = 'TracAccountManager',
+    version = '0.1.3',
+    author = 'Matthew Good',
+    author_email = 'trac@matt-good.net',
+    url = 'http://trac-hacks.org/wiki/AccountManagerPlugin',
+    description = u'Plugin de gestion de compte utilisateur pour Trac',
+
+    license = '''
+"THE BEER-WARE LICENSE" (Revision 42):
+<trac@matt-good.net> wrote this file.  As long as you retain this notice you
+can do whatever you want with this stuff. If we meet some day, and you think
+this stuff is worth it, you can buy me a beer in return.   Matthew Good''',
+
+    zip_safe=True,
+    packages=['acct_mgr'],
+    package_data={'acct_mgr': ['templates/*.cs']},
+
+    install_requires = [
+        'TracWebAdmin',
+    ],
+
+    entry_points = {
+        'trac.plugins': [
+            'acct_mgr.web_ui = acct_mgr.web_ui',
+            'acct_mgr.htfile = acct_mgr.htfile',
+            'acct_mgr.http = acct_mgr.http',
+            'acct_mgr.api = acct_mgr.api',
+            'acct_mgr.admin = acct_mgr.admin',
+            'acct_mgr.db = acct_mgr.db',
+            'acct_mgr.pwhash = acct_mgr.pwhash',
+        ]
+    },
+
+    test_suite = 'acct_mgr.tests.suite',
+)
Index: /TracAccountManager/processus.txt
===================================================================
--- /TracAccountManager/processus.txt	(revision 3)
+++ /TracAccountManager/processus.txt	(revision 3)
@@ -0,0 +1,16 @@
+ * Contrôle de la version avec :
+$ svn info http://trac-hacks.org/svn/accountmanagerplugin/0.10
+...
+Révision de la dernière modification : 2548
+...
+
+ * Export de la version:
+$ svn export http://trac-hacks.org/svn/accountmanagerplugin/0.10
+
+ * Mise à jour du code source
+
+ * Compilation du plugin:
+$ python setup.py bdist_egg
+
+ * Copie du fichier egg généré en indiquant la révision utilisée:
+$ cp dist/TracAccountManager-0.1.3dev-py2.5.egg ../TracAccountManager-0.1.3dev_r2548-py2.5.egg
