From: Ian Jackson Date: Wed, 2 Sep 2009 00:07:16 +0000 (+0100) Subject: Merge branch 'test-install' X-Git-Tag: 3.4~26 X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.main.git;a=commitdiff_plain;h=59bee7afb77216585b904bd20f17e71005e9778c;hp=6ddc370cd549fab89225d2ba28b992fbea62a477 Merge branch 'test-install' --- diff --git a/.gitignore b/.gitignore index 5796988..a058839 100644 --- a/.gitignore +++ b/.gitignore @@ -13,3 +13,4 @@ yarrg/yarrg yarrg/_*.* yarrg/OCEAN-*.db yarrg/Writer.lock +yarrg/DATA diff --git a/COPYING b/COPYING index 4432540..508a35e 100644 --- a/COPYING +++ b/COPYING @@ -1,3 +1,22 @@ +This licence applies to the general purpose ypp-sc-tools, the +YARRG client code and code shared with the YARRG website. + +It DOES NOT apply to: + + * The code for YARRG website, which is also Free Software + but covered by the Affero GPL - see COPYING.WEBSITE. + + * master-info.txt, ocean-*.txt, which contain information about the + Yohoho Puzzle Pirates world. Insofar as this information is + Copyright by Three Rings (the company behind Puzzle Pirates) + I believe that our usage is Fair Dealing. + + * The market data presented through the website. This is + a collection of facts and not subject to copyright. + +See the individual files' copyright notices for details. + + GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 diff --git a/COPYING.WEBSITE b/COPYING.WEBSITE new file mode 100644 index 0000000..4c0dff4 --- /dev/null +++ b/COPYING.WEBSITE @@ -0,0 +1,667 @@ +This licence applies to the YARRG website, whose files can be found in: + yarrg/CommodsWeb.pm + yarrg/web/ +See the individual files' copyright notices for details. + + + GNU AFFERO GENERAL PUBLIC LICENSE + Version 3, 19 November 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU Affero General Public License is a free, copyleft license for +software and other kinds of works, specifically designed to ensure +cooperation with the community in the case of network server software. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +our General Public Licenses are intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + Developers that use our General Public Licenses protect your rights +with two steps: (1) assert copyright on the software, and (2) offer +you this License which gives you legal permission to copy, distribute +and/or modify the software. + + A secondary benefit of defending all users' freedom is that +improvements made in alternate versions of the program, if they +receive widespread use, become available for other developers to +incorporate. Many developers of free software are heartened and +encouraged by the resulting cooperation. However, in the case of +software used on network servers, this result may fail to come about. +The GNU General Public License permits making a modified version and +letting the public access it on a server without ever releasing its +source code to the public. + + The GNU Affero General Public License is designed specifically to +ensure that, in such cases, the modified source code becomes available +to the community. It requires the operator of a network server to +provide the source code of the modified version running there to the +users of that server. Therefore, public use of a modified version, on +a publicly accessible server, gives the public access to the source +code of the modified version. + + An older license, called the Affero General Public License and +published by Affero, was designed to accomplish similar goals. This is +a different license, not a version of the Affero GPL, but Affero has +released a new version of the Affero GPL which permits relicensing under +this license. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU Affero General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Remote Network Interaction; Use with the GNU General Public License. + + Notwithstanding any other provision of this License, if you modify the +Program, your modified version must prominently offer all users +interacting with it remotely through a computer network (if your version +supports such interaction) an opportunity to receive the Corresponding +Source of your version by providing access to the Corresponding Source +from a network server at no charge, through some standard or customary +means of facilitating copying of software. This Corresponding Source +shall include the Corresponding Source for any work covered by version 3 +of the GNU General Public License that is incorporated pursuant to the +following paragraph. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the work with which it is combined will remain governed by version +3 of the GNU General Public License. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU Affero General Public License from time to time. Such new versions +will be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU Affero General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU Affero General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU Affero General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If your software can interact with users remotely through a computer +network, you should also make sure that it provides a way for users to +get its source. For example, if your program is a web application, its +interface could display a "Source" link that leads users to an archive +of the code. There are many ways you could offer source, and different +solutions will be better for different programs; see section 13 for the +specific requirements. + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU AGPL, see +. diff --git a/yarrg/Commods.pm b/yarrg/Commods.pm index b90e6d7..860510e 100644 --- a/yarrg/Commods.pm +++ b/yarrg/Commods.pm @@ -41,24 +41,35 @@ BEGIN { &pipethrough_prep &pipethrough_run &pipethrough_run_along &pipethrough_run_finish &pipethrough_run_gzip - &cgipostform &yarrgpostform &cgi_get_caller); + &cgipostform &yarrgpostform &cgi_get_caller + &set_ctype_utf8 $masterinfoversion); %EXPORT_TAGS = ( ); @EXPORT_OK = qw(); } +our $masterinfoversion= 2; # version we understand + our %oceans; # eg $oceans{'Midnight'}{'Ruby'}{'Eta Island'}= $sources; -our %commods; # eg $commods{'Fine black cloth'}= $sources; our %clients; # eg $clients{'ypp-sc-tools'}= [ qw(last-page) ]; our %routes; # eg $routes{'Midnight'}{'Orca'}{'Tinga'}= $sources NB abbrevs! our %route_mysteries; # eg $route_mysteries{'Midnight'}{'Norse'}= 3 # $sources = 's[l]b'; # 's' = Special Circumstances; 'l' = local ; B = with Bleach +our %commods; +# eg $commods{'Fine black cloth'}{Srcs}= $sources; +# eg $commods{'Fine black cloth'}{Mass}= 700 [g] +# eg $commods{'Fine black cloth'}{Volume}= 1000 [ml] + our (%pctb_commodmap,@pctb_commodmap); my %colours; # eg $colours{'c'}{'black'}= $sources -my @rawcm; # eg $rawcm[0]='fine rum'; $rawcm[1]='fine %c cloth' +my (@rawcm, @nocm); # eg $rawcm[0]='fine rum'; $rawcm[1]='fine %c cloth' + +# IMPORTANT +# when extending the format of source-info in a non-backward +# compatible way, be sure to update update-master-info too. sub parse_info1 ($$) { my ($mmfn,$src)= @_; @@ -73,12 +84,16 @@ sub parse_info1 ($$) { @ctx= (sub { $colours{$colourkind}{lc $_} .= $src; }); } elsif (m/^commods$/) { @ctx= (sub { push @rawcm, lc $_; }); + } elsif (m/^nocommods$/) { + @ctx= (sub { push @nocm, lc $_; }); } elsif (m/^ocean (\w+)$/) { my $ocean= $1; + keys %{ $oceans{$ocean} }; @ctx= (sub { $ocean or die; # ref to $ocean needed to work # around a perl bug my $arch= $_; + keys %{ $oceans{$ocean}{$arch} }; $ctx[1]= sub { $oceans{$ocean}{$arch}{$_} .= $src; }; @@ -115,10 +130,30 @@ sub parse_info1 ($$) { $ca= sub { my ($s,$ss) = @_; #print "ca($s)\n"; - if ($s !~ m/\%(\w+)/) { $commods{ucfirst $s} .= $ss; return; } + if ($s !~ m/\%(\w+)/) { + my ($name, $props) = $s =~ + /^(\S[^\t]*\S)(?:\t+(\S[^\t]*\S))?$/ + or die "bad commodspec $s"; + return if grep { $name eq $_ } @nocm; + my $ucname= ucfirst $name; + $commods{$ucname}{Srcs} .= $ss; + my $c= $commods{$ucname}; + $c->{Volume}= 1000; + foreach my $prop (defined $props ? split /\s+/, $props : ()) { + if ($prop =~ m/^([1-9]\d*)(k?)g$/) { + $c->{Mass}= $1 * ($2 ? 1000 : 1); + } elsif ($prop =~m/^([1-9]\d*)l$/) { + $c->{Volume}= $1 * 1000; + } else { + die "unknown property $prop for $ucname"; + } + } + return; + } die "unknown $&" unless defined $colours{$1}; - foreach my $c (keys %{ $colours{$1} }) { - &$ca($`.$c.$', $ss .'%'. $colours{$1}{$c}); + my ($lhs,$pctlet,$rhs)= ($`,$1,$'); + foreach my $c (keys %{ $colours{$pctlet} }) { + &$ca($lhs.$c.$rhs, $ss .'%'. $colours{$pctlet}{$c}); } }; foreach (@rawcm) { &$ca($_,$src); } @@ -143,7 +178,7 @@ sub parse_info1 ($$) { sub parse_info_clientside () { my $yarrg= $ENV{'YPPSC_YARRG_DICT_UPDATE'}; return unless $yarrg; - my $master= fetch_with_rsync('info'); + my $master= fetch_with_rsync("info-$masterinfoversion"); parse_info1($master,'s'); my $local= '_local-info.txt'; if (stat $local) { @@ -185,26 +220,26 @@ sub parse_info_maproutes ($$$) { } sub parse_info_serverside () { - parse_info1('master-info.txt','s'); + parse_info1('source-info.txt','s'); } sub parse_info_serverside_ocean ($) { my ($oceanname) = @_; die "unknown ocean $oceanname ?" unless exists $oceans{$oceanname}; - parse_info1("ocean-".(lc $oceanname).".txt",'s'); + parse_info1("_ocean-".(lc $oceanname).".txt",'s'); } sub parse_pctb_commodmap () { undef %pctb_commodmap; - foreach my $commod (keys %commods) { $commods{$commod} =~ s/b//; } + foreach my $commod (keys %commods) { $commods{$commod}{Srcs} =~ s/b//; } - my $c= new IO::File '_commodmap.tsv' or die $!; + my $c= new IO::File '_commodmap.tsv'; if (!$c) { $!==&ENOENT or die $!; return 0; } while (<$c>) { m/^(\S.*\S)\t(\d+)\n$/ or die "$_"; die if defined $pctb_commodmap{$1}; $pctb_commodmap{$1}= $2; die if defined $pctb_commodmap[$2]; $pctb_commodmap[$2]= $1; - $commods{$1} .= 'b'; + $commods{$1}{Srcs} .= 'b'; } $c->error and die $!; close $c or die $!; @@ -214,9 +249,9 @@ sub parse_pctb_commodmap () { sub get_our_version ($$) { my ($aref,$prefix) = @_; $aref->{"${prefix}name"}= 'ypp-sc-tools yarrg'; - $aref->{"${prefix}fixes"}= 'lastpage'; + $aref->{"${prefix}fixes"}= 'lastpage checkpager'; - my $version= `git-describe --tags HEAD`; $? and die $?; + my $version= `git-describe --tags HEAD || echo 0unknown`; $? and die $?; chomp($version); $aref->{"${prefix}version"}= $version; return $aref; @@ -232,6 +267,7 @@ sub pipethrough_prep () { sub pipethrough_run_along ($$$@) { my ($tf, $childprep, $cmd, @a) = @_; + $tf->error and die $!; $tf->flush or die $!; $tf->seek(0,0) or die $!; my $fh= new IO::File; @@ -302,7 +338,8 @@ sub cgipostform ($$$) { return $'; } else { my $resp= $ua->request($req); - die $resp->status_line unless $resp->is_success; + die $resp->status_line."\n".$resp->content."\n " + unless $resp->is_success; return $resp->content(); } } @@ -356,4 +393,8 @@ sub cgi_get_caller () { return $caller; } +sub set_ctype_utf8 () { + setlocale(LC_CTYPE, "en.UTF-8"); +} + 1; diff --git a/yarrg/CommodsDatabase.pm b/yarrg/CommodsDatabase.pm index 6f2f627..79744ce 100644 --- a/yarrg/CommodsDatabase.pm +++ b/yarrg/CommodsDatabase.pm @@ -44,18 +44,39 @@ BEGIN { $VERSION = 1.00; @ISA = qw(Exporter); @EXPORT = qw(&db_setocean &db_writer &db_connect $dbh - &db_filename &db_doall &db_onconflict); + &db_filename &db_doall &db_onconflict + &dbr_filename &dbr_connect); %EXPORT_TAGS = ( ); @EXPORT_OK = qw(); } +sub dbr_filename ($$) { + my ($datadir,$oceanname) = @_; + return "$datadir/OCEAN-$oceanname.db"; +} +sub dbr_connect ($$) { + my ($datadir,$ocean) = @_; + return connect_core(dbr_filename($datadir,$ocean)); +} + +sub connect_core ($) { + my ($fn)= @_; + my $h= DBI->connect("dbi:SQLite:$fn",'','', + { AutoCommit=>0, + RaiseError=>1, ShowErrorStatement=>1, + unicode=>1 }) + or die "$fn $DBI::errstr ?"; + return $h; + # default timeout is 30s which is plenty +} + our $dbfn; our $dbh; sub db_setocean ($) { my ($oceanname) = @_; - $dbfn= "OCEAN-$oceanname.db"; + $dbfn= dbr_filename('.',$oceanname); } sub db_filename () { return $dbfn; @@ -89,12 +110,7 @@ sub db_writer () { } sub db_connect () { - $dbh= DBI->connect("dbi:SQLite:$dbfn",'','', - { AutoCommit=>0, - RaiseError=>1, ShowErrorStatement=>1, - unicode=>1 }) - or die "$dbfn $DBI::errstr ?"; - # default timeout is 30s which is plenty + $dbh= connect_core($dbfn); } sub db_doall ($) { diff --git a/yarrg/CommodsWeb.pm b/yarrg/CommodsWeb.pm new file mode 100644 index 0000000..198185d --- /dev/null +++ b/yarrg/CommodsWeb.pm @@ -0,0 +1,154 @@ +# This is part of the YARRG website. YARRG is a tool and website +# for assisting players of Yohoho Puzzle Pirates. +# +# Copyright (C) 2009 Ian Jackson +# Copyright (C) 2009 Clare Boothby +# +# YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later). +# The YARRG website is covered by the GNU Affero GPL v3 or later, which +# basically means that every installation of the website will let you +# download the source. +# +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU Affero General Public License as +# published by the Free Software Foundation, either version 3 of the +# License, or (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU Affero General Public License for more details. +# +# You should have received a copy of the GNU Affero General Public License +# along with this program. If not, see . +# +# Yohoho and Puzzle Pirates are probably trademarks of Three Rings and +# are used without permission. This program is not endorsed or +# sponsored by Three Rings. + + +# This Perl module is used by the Mason scripts in yarrg/web/. +# We look for a symlink DATA to the actual data to use, so that +# the data uploader and website displayer can use different code. + +package CommodsWeb; + +use strict; +use warnings; + +use DBI; +use POSIX; +use JSON; + +use Commods; +use CommodsDatabase; + +BEGIN { + use Exporter (); + our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); + $VERSION = 1.00; + @ISA = qw(Exporter); + @EXPORT = qw(&dbw_connect &ocean_list &sourcebasedir + &to_json_shim &to_json_protecttags + &set_ctype_utf8 + &prettyprint_age &meta_prettyprint_age); + %EXPORT_TAGS = ( ); + + @EXPORT_OK = qw(); +} + +sub dotperllibdir () { + my $dir; + + for my $dir (@INC) { + if ($dir =~ m/\.perl-lib$/) { + return $dir; + } + } + die "no appropriate dotperllib dir in @INC"; +} + +sub sourcebasedir () { + return dotperllibdir().'/..'; +} + +sub datadir () { + my $edir= $ENV{'YARRG_DATA_DIR'}; + return $edir if defined $edir; + my $dir= dotperllibdir(); + if (stat "$dir/DATA") { + return "$dir/DATA"; + } elsif ($!==&ENOENT) { + return "$dir"; + } else { + die "stat $dir/DATA $!"; + } + return '.'; +} + +my @ocean_list; + +sub ocean_list () { + my $datadir= datadir(); + if (!@ocean_list) { + my $fn= "$datadir/source-info.txt"; + my $f= new IO::File $fn or die "$fn $!"; + my @r; + while (<$f>) { + next unless m/^ocean\s+(\S.*\S)\s*$/; + push @r, $1; + } + $f->error and die $!; + close $fn; + @ocean_list= @r; + } + return @ocean_list; +} + +sub dbw_connect ($) { + my ($ocean) = @_; + die "unknown ocean $ocean ?" + unless grep { $_ eq $ocean } ocean_list(); + return dbr_connect(datadir(), $ocean); +} + +sub to_json_shim ($) { + my ($obj) = @_; + # In JSON.pm 2.x, jsonToObj prints a warning to stderr which + # our callers don't like at all. + if ($JSON::VERSION >= 2.0) { + return to_json($obj); + } else { + return objToJson($obj); + } +} + +sub to_json_protecttags ($) { + my ($v) = @_; + my $j= to_json_shim($v); + $j =~ s,/,\\/,g; + return $j; +} + +sub meta_prettyprint_age ($$$) { + my ($age,$floor,$plus) = @_; + return < -Copyright (C) 2009 Stephen Early +Copyright (C) 2009 Clare Boothby 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. +it under the terms of + (a) for the website code, the GNU Affero General Public License and + (b) for the rest of the code, GNU General Public License +as published by the Free Software Foundation, either version 3 of +each applicable 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 . +You should have received a copy of the GNU General Public License and +GNU Affero General Public License along with this program. If not, +see . Yohoho and Puzzle Pirates are probably trademarks of Three Rings and -are used without permission. This program is not endorsed or -sponsored by Three Rings. +are used without permission. Once again, this program is not endorsed +or sponsored by Three Rings. The character and UI images copied from the YPP client, and submitted diff --git a/yarrg/README.files b/yarrg/README.files index b32f7fc..daee35f 100644 --- a/yarrg/README.files +++ b/yarrg/README.files @@ -37,6 +37,11 @@ The program reads and writes the following files: double-check what you're doing before overriding the uploader by telling it to ignore an unrecognised commodity. + * _master-info*.txt _local-info.txt + + Database of valid commodities and islands/oceans for use when + uploading to YARRG. + * _master-reject.txt _local-reject.txt Dictionary of regexps which, when the OCR appears to match, we diff --git a/yarrg/TODO b/yarrg/TODO index 595558a..a2e2f34 100644 --- a/yarrg/TODO +++ b/yarrg/TODO @@ -1 +1,54 @@ -more flexible installation arrangements +UPLOADER +-------- + + detect all unexpected mouse movements + + more flexible installation arrangements + + W windows uploader + +DATABASE/DICTIONARY MANAGER +--------------------------- + + commodity mass/volume in live database + eliminate black dye from live database + + when update rejected print better error message including + broken commodity name + + notice commodities deleted from source-info and warn about them + + support Opal and Jade (currently there are some unicode problems) + +WEBSITE +------- + + multi-visit routes / circular routes + + adjustable potential cost of losses (rather than fixed + 1e-BIG per league) + use power formula (compound interest) + suggest 0.5% + + initial/final stocks feature + + max volume/mass + + max capital + + better documentation + + printable voyage trading plan + + +KEYLETTERS +---------- + +P needed before public release +O needed before public release to support multiple oceans + +C needs ypp client and network connection +N needs network connection +W needs to be done by someone with Windows + +D dependencies unsatisfied diff --git a/yarrg/commod-email-processor b/yarrg/commod-email-processor index 0c16cd1..1cff462 100755 --- a/yarrg/commod-email-processor +++ b/yarrg/commod-email-processor @@ -39,7 +39,7 @@ BEGIN { use Commods; use CommodsDatabase; -setlocale(LC_CTYPE, "en_GB.UTF-8"); +set_ctype_utf8(); my $parser= new MIME::Parser; our $entity; @@ -123,33 +123,38 @@ sub main () { $islandid, $mid, map { $md{$_} } (qw(timestamp clientspec serverspec))); - my (%sth, %sub_cs, %cache_cs, %sth_insert); + my (%sth, %sub_cs, %cache_cs, %sth_insert, %sth_lookup); $sth_insert{'stall'}= $dbh->prepare( "INSERT OR IGNORE INTO stalls (islandid, stallname) VALUES ($islandid, ?) "); - $sth_insert{'commods'}= $dbh->prepare( + $sth_lookup{'stall'}= $dbh->prepare( + "SELECT stallid FROM stalls + WHERE islandid == $islandid AND stallname == ? + "); + $sth_insert{'commod'}= $dbh->prepare( "INSERT OR IGNORE INTO commods (commodname) VALUES (?) "); + $sth_lookup{'commod'}= $dbh->prepare( + "SELECT commodid FROM commods + WHERE commodname == ? + "); foreach my $cs (qw(stall commod)) { - my $sth_lookup= $dbh->prepare( - "SELECT ${cs}id FROM ${cs}s WHERE ${cs}name == ?; - "); $sub_cs{$cs}= sub { my ($name)= @_; my $r= $cache_cs{$cs}{$name}; return $r if defined $r; - $sth_lookup->execute($name) or die; - ($r)= $sth_lookup->fetchrow_array(); + $sth_lookup{$cs}->execute($name) or die; + ($r)= $sth_lookup{$cs}->fetchrow_array(); if (!defined $r) { $sth_insert{$cs}->execute($name); - $sth_lookup->execute($name) or die; - ($r)= $sth_lookup->fetchrow_array(); + $sth_lookup{$cs}->execute($name) or die; + ($r)= $sth_lookup{$cs}->fetchrow_array(); die unless defined $r; } $cache_cs{$cs}{$name}= $r; diff --git a/yarrg/commod-update-receiver b/yarrg/commod-update-receiver index 3ae1a62..9684c69 100755 --- a/yarrg/commod-update-receiver +++ b/yarrg/commod-update-receiver @@ -35,7 +35,7 @@ $CGI::POST_MAX= 3*1024*1024; use CGI qw/:standard -private_tempfiles/; -setlocale(LC_CTYPE, "en_GB.UTF-8"); +set_ctype_utf8(); our $now= time; defined $now or die $!; @@ -49,7 +49,7 @@ sub fail ($) { print header(-status=>'400 Bad commodity update', -type=>'text/plain', -charset=>'us-ascii'); - print "Error: $msg\n"; + print "\nError: $msg\n"; exit 0; } diff --git a/yarrg/common.c b/yarrg/common.c index f95e585..cc33235 100644 --- a/yarrg/common.c +++ b/yarrg/common.c @@ -122,7 +122,7 @@ int gzopen(const char *zpath, int oflags, FILE **f_r, pid_t *pid_r, const char *gziplevel /* 0 for read; may be 0, or "-1" etc. */) { int zfd= open(zpath, oflags, 0666); - if (!zfd) return errno; + if (zfd<0) return errno; int pipefds[2]; sysassert(! pipe(pipefds) ); diff --git a/yarrg/convert.c b/yarrg/convert.c index adccb1c..555eefe 100644 --- a/yarrg/convert.c +++ b/yarrg/convert.c @@ -262,6 +262,7 @@ int main(int argc, char **argv) { else if (IS("--dict-read-only")) o_flags &= (~ffs_dict | ff_dict_fetch); else if (IS("--dict-anon")) o_flags &= ~ff_dict_pirate; else if (IS("--dict-submit")) o_flags |= ff_dict_fetch|ff_dict_submit; + else if (IS("--dict-no-update")) o_flags &= ~ff_dict_fetch; // testing else if (IS("--raw-tsv")) outputmode(omk_raw,0); else if (IS("--upload")) outputmode_uploads(); else if (IS("--upload-yarrg")) outputmode(omk_upload_yarrg,arg+2); diff --git a/yarrg/convert.h b/yarrg/convert.h index 82ea369..fadfe93 100644 --- a/yarrg/convert.h +++ b/yarrg/convert.h @@ -76,6 +76,7 @@ void store_current_page(CanonImage *ci /*pointer saved*/, void adjust_colours(CanonImage *ci, const RgbImage *rgb); void select_page(int page); +void check_pager_motion(int first, int stop); Rect find_sunshine_widget(void); diff --git a/yarrg/database-info-fetch b/yarrg/database-info-fetch index 1e789b8..5e05760 100755 --- a/yarrg/database-info-fetch +++ b/yarrg/database-info-fetch @@ -159,7 +159,7 @@ sub main__comparesources () { sub { }); for_commods(sub { my ($commod)= @_; - my $srcs= $commods{$commod}; + my $srcs= $commods{$commod}{Srcs}; compare_sources_one($srcs, "commodity $commod"); }); } diff --git a/yarrg/db-idempotent-populate b/yarrg/db-idempotent-populate index 96df020..143e2ef 100755 --- a/yarrg/db-idempotent-populate +++ b/yarrg/db-idempotent-populate @@ -1,5 +1,8 @@ #!/usr/bin/perl -w # +# Normally run from +# update-master-info +# # usage: ./db-idempotent-populate # creates or updates OCEAN-Oceanname.db # from master-master.txt @@ -39,8 +42,6 @@ my ($oceanname) = @ARGV; #---------- setup ---------- parse_info_serverside(); -parse_info_serverside_ocean($oceanname); -our $ocean= $oceans{$oceanname}; db_setocean($oceanname); db_writer(); @@ -95,6 +96,12 @@ db_doall(<commit; #---------- commodity list ---------- { - my $sth= $dbh->prepare(<<'END') - INSERT OR IGNORE INTO commods (commodname) VALUES (?); + my $insert= $dbh->prepare(<<'END') + INSERT OR IGNORE INTO commods + (unitmass, + unitvolume, + commodname) + VALUES (?,?,?); END ; - foreach my $commod (sort keys %commods) { - $sth->execute($commod); - } - $dbh->commit; -} - -#---------- island list ---------- - -{ - my $sth= $dbh->prepare(<<'END') - INSERT OR IGNORE INTO islands (islandname, archipelago) VALUES (?, ?); + my $update= $dbh->prepare(<<'END') + UPDATE commods + SET unitmass = ?, + unitvolume = ? + WHERE commodname = ? END ; - foreach my $archname (sort keys %$ocean) { - my $arch= $ocean->{$archname}; - foreach my $islandname (sort keys %$arch) { - $sth->execute($islandname, $archname); - } + foreach my $commod (sort keys %commods) { + my $c= $commods{$commod}; + die "no mass for $commod" unless defined $c->{Mass}; + die "no colume for $commod" unless defined $c->{Volume}; + my @qa= ($c->{Mass}, $c->{Volume}, $commod); + $insert->execute(@qa); + $update->execute(@qa); } $dbh->commit; } +#---------- island list ---------- #---------- routes ---------- - -{ - foreach my $islandname (sort keys %{ $route_mysteries{$oceanname} }) { - warn "$route_mysteries{$oceanname}{$islandname} routes". - " for unknown island $islandname\n"; - } - - my $allroutes= $routes{$oceanname}; - - my @propqueue= (); - - sub distance_set_propagate ($$$$) { - my ($lev, $start, $upto, $start2upto) = @_; - $allroutes->{$start}{$upto}= $start2upto; - push @propqueue, [ $lev, $start, $upto ]; - } - - sub distance_propagate_now { - my ($lev, $start, $upto) = @_; - my $startref= $allroutes->{$start}; - my $start2upto= $startref->{$upto}; - my $uptoref= $allroutes->{$upto}; - - for my $next (keys %$uptoref) { - next if $next eq $upto; - my $unext= $uptoref->{$next}; - next unless defined $unext; - distance_update("${lev}p", $start, $next, $start2upto + $unext); - } - } - - sub distance_update ($$$$) { - my ($lev, $x, $y, $newdist) = @_; - distance_update_one("${lev}x",$x,$y,$newdist); - distance_update_one("${lev}y",$y,$x,$newdist); - } - - sub distance_update_one ($$$$) { - my ($lev, $x, $y, $newdist) = @_; - my $xref= $allroutes->{$x}; - my $currently= $xref->{$y}; - return if defined($currently) and $currently <= $newdist; - distance_set_propagate("${lev}o",$x,$y,$newdist); - } - - foreach my $xn (keys %$allroutes) { - my $routes= $allroutes->{$xn}; - distance_set_propagate('0', $xn, $xn, 0); - foreach my $yn (keys %$routes) { - distance_set_propagate('0', $yn, $yn, 0); - distance_set_propagate('X', $xn, $yn, $routes->{$yn}); - distance_set_propagate('Y', $yn, $xn, $routes->{$yn}); - } - } - my $ref; - while ($ref= shift @propqueue) { - distance_propagate_now(@$ref); - } - - db_doall(<prepare(<<'END') - INSERT INTO dists VALUES - ((SELECT islandid FROM islands WHERE islandname == ?), - (SELECT islandid FROM islands WHERE islandname == ?), - ?); -END - ; - foreach my $xn (keys %$allroutes) { - my $routes= $allroutes->{$xn}; - foreach my $yn (keys %$routes) { - $sth->execute($xn, $yn, $routes->{$yn}); - } - } - $dbh->commit(); - - # select ia.islandname, ib.islandname,dists.dist from dists, islands as ia on dists.aiid = ia.islandid, islands as ib on dists.biid = ib.islandid order by ia.islandname, ib.islandname; -} +# now done by yppedia-chart-parser __DATA__ diff --git a/yarrg/devel-notes b/yarrg/devel-notes new file mode 100644 index 0000000..f4f6066 --- /dev/null +++ b/yarrg/devel-notes @@ -0,0 +1,41 @@ + +removing an obsolete commodity: + + select * from (select * from sell union select * from buy) left outer join commods using (commodid) where commods.commodname = 'Black dye' limit 10; + +if that produces no output then: + + begin; + delete from commods where commodname like 'Black dye'; + select * from (select * from sell union select * from buy) left outer join commods using (commodid) where commods.commodname is null limit 10; + +and if that produces no output then: + commit; +otherwise + rollback; + +======================================= + +ceb's example route: + alpha,byrne,papaya,turtle,jorvik,luthien + +example mixed arbitrage/trade + xi,heph + +======================================== + +To remedy bug fixed in 01c14767c024ac56686dbbfcd88d9f3a0b4b1574, +did this: + +sqlite> begin; +sqlite> insert or ignore into stalls select null, buy.islandid, stalls.stallname from buy, stalls using (stallid); +sqlite> insert or ignore into stalls select null, sell.islandid, stalls.stallname from sell, stalls using (stallid); +sqlite> update buy set stallid = (select stallid from stalls where stalls.islandid == buy.islandid and stalls.stallname == (select stallname from stalls as bad where buy.stallid == bad.stallid)); +sqlite> update sell set stallid = (select stallid from stalls where stalls.islandid == sell.islandid and stalls.stallname == (select stallname from stalls as bad where sell.stallid == bad.stallid)); +sqlite> commit; + +And to check that it worked: + +sqlite> select * from buy offers, stalls using (stallid) where offers.islandid != stalls.islandid group by offers.islandid; +sqlite> select * from sell offers, stalls using (stallid) where offers.islandid != stalls.islandid group by offers.islandid; +sqlite> diff --git a/yarrg/dictionary-manager b/yarrg/dictionary-manager index c8e003d..623e07d 100755 --- a/yarrg/dictionary-manager +++ b/yarrg/dictionary-manager @@ -25,9 +25,9 @@ # sponsored by Three Rings. -# ./dictionary-manager --approve-updates ijackson@login.chiark.greenend.org.uk /home/ijackson/things/ypp-sc-tools.pctb-dict/pctb /home/ftp/users/ijackson/pctb +# ./dictionary-manager --approve-updates ijackson@login.chiark.greenend.org.uk /home/ijackson/things/ypp-sc-tools.pctb-dict/yarrg /home/ftp/users/ijackson/yarrg -# ./dictionary-manager --approve-updates ijackson@login.chiark.greenend.org.uk /home/ijackson/things/ypp-sc-tools.pctb-dict-test/pctb /home/ftp/users/ijackson/pctb/test +# ./dictionary-manager --approve-updates ijackson@login.chiark.greenend.org.uk /home/ijackson/things/ypp-sc-tools.pctb-dict-test/yarrg /home/ftp/users/ijackson/yarrg/test # ./dictionary-manager --approve-updates '' . . diff --git a/yarrg/master-info.txt b/yarrg/master-info.txt deleted file mode 100644 index eb8d666..0000000 --- a/yarrg/master-info.txt +++ /dev/null @@ -1,168 +0,0 @@ - -commods - %c dye - %c enamel - %c paint - - %c cloth - fine %c cloth - - %g gems - -%c - aqua - black - blue - brown - gold - green - grey - lavender - lemon - light blue - light green - lime - magenta - maroon - mint - navy - orange - peach - persimmon - pink - purple - red - rose - tan - violet - white - yellow - -%g - amber - amethyst - beryl - coral - jade - jasper - jet - lapis lazuli - quartz - tigereye - -commods - bananas - broom flower - butterfly weed - carambolas - chalcocite - coconuts - cowslip - cubanite - diamonds - durians - elderberries - emeralds - fine rum - gold nuggets - gold ore - grog - hemp - hemp oil - indigo - iris root - iron - kraken's blood - lacquer - large cannon balls - leushite - lily of the valley - limes - lobelia - lorandite - madder - mangos - masuyite - medium cannon balls - moonstones - nettle - old man's beard - opals - papagoite - passion fruit - pearls - pineapples - pokeweed berries - pomegranates - rambutan - rubies - sail cloth - sapphires - sassafras - serandite - sincosite - small cannon balls - stone - sugar cane - swill - tellurium - thorianite - topazes - varnish - weld - wood - yarrow - -ocean Midnight - Coral - Angelfish Island - Delta Island - Meke Island - Park Island - Diamond - Alpha Island - Byrne Island - Cnossos Island - Oyster Island - Papaya Island - Turtle Island - Winter Solstice - Emerald - Emperor Island - Epsilon Island - Gaea Island - Guava Island - Spring Island - Tinga Island - Wrasse Island - Jet - Chaparral Island - Eclipse Island - Hephaestus' Forge - Lagniappe Island - Namath Island - Xi Island - Opal - Endurance Island - Nu Island - Orca Island - Waterberry - Pearl - Cleopatra's Pearls - Frond Island - Ostreum Island - Zeta Island - Ruby - Eta Island - Cranberry Island - Islay of Luthien - Jorvik Island - Midsummer - Sapphire - Beta Island - Iris Island - Remora Island - Vernal Equinox - -client ypp-sc-tools yarrg - lastpage diff --git a/yarrg/notes.linear-programming b/yarrg/notes.linear-programming new file mode 100644 index 0000000..e3c684c --- /dev/null +++ b/yarrg/notes.linear-programming @@ -0,0 +1,7 @@ +use glpk's standalone solver with cplex input, see + glpk refman.ps.gz p84 for example +don't use it own modelling language which is very complex + +Math::LP would be nice but depends on Math::LP::Solve which is not in + Debian. + diff --git a/yarrg/ocean-midnight.txt b/yarrg/ocean-midnight.txt deleted file mode 100644 index f7c8059..0000000 --- a/yarrg/ocean-midnight.txt +++ /dev/null @@ -1,129 +0,0 @@ -routes Midnight - # Try to include "shortcut" routes (those where you can chart a - # league that isn't actually on any inter-island charts), but if you - # don't it won't affect things too much. - - # Ruby internal - Olivia, Midsummer, 3 - Midsummer, Cranberry, 2 - Olivia, Lynx, 5 - Olivia, Eta, 7 - Cranberry, Eta, 3 - Lynx, Eta, 3 - Lynx, Islay of Luthien, 5 - Eta, Islay of Luthien, 4 - Islay of Luthien, Jorvik, 5 - Eta, Jorvik, 5 - - # Pearl internal and interarch - Cleopatra, O'Reilly, 3 - Cleopatra, Zeta, 4 - Cleopatra, Nuptial, 6 - O'Reilly, Nuptial, 4 - O'Reilly, Zeta, 6 - Nuptial, Zeta, 4 - Nuptial, Ostreum, 6 - Zeta, Tadpole, 4 - Tadpole, Ostreum, 6 - Tadpole, Frond, 4 - Frond, Ostreum, 4 - Frond, Zeta, 6 - Nuptial, Islay of Luthien, 10 - Ostreum, Wrasse, 6 - Ostreum, Gaea, 10 - Frond, Wrasse, 9 - Frond, Gaea, 13 - - # Diamond internal and interarch - this has lots of shortcut routes - Turtle, Jorvik, 6 - Turtle, Papaya, 3 - Turtle, Cnossos, 8 - Turtle, Alpha, 7 - Papaya, Byrne, 3 - Papaya, Alpha, 6 - Papaya, Oyster, 8 - Papaya, Winter Solstice, 11 - Cnossos, Alpha, 3 - Cnossos, Winter Solstice, 4 - Cnossos, Guava, 6 - Winter Solstice, Guava, 9 - Winter Solstice, Alpha, 6 - Winter Solstice, Oyster, 5 - Winter Solstice, Park, 11 - Winter Solstice, Delta, 16 - Winter Solstice, Byrne, 9 - Alpha, Oyster, 3 - Oyster, Park, 7 - Oyster, Delta, 12 - Alpha, Byrne, 4 - Byrne, Remora, 10 - Papaya, Remora, 8 - - # Emerald internal and interarch to Jet and Opal - Wrasse, Guava, 5 - Wrasse, Gaea, 5 - Wrasse, Epsilon, 11 - Guava, Epsilon, 7 - Gaea, Epsilon, 4 - Gaea, Tinga, 8 - Epsilon, Emperor, 3 - Epsilon, Spring, 6 - Emperor, Spring, 4 - Epsilon, Tinga, 5 - Tinga, Spring, 4 - Tinga, Hephaestus, 11 - Spring, Hephaestus, 8 - Tinga, Orca, 8 - - # Opal internal - Orca, Endurance, 3 - Orca, Norse, 5 - Orca, Nu, 4 - Nu, Norse, 3 - Nu, Endurance, 3 - Nu, Oseberg, 4 - Norse, Oseberg, 6 - Norse, Waterberry, 4 - Waterberry, Boyle, 3 - Boyle, Flow, 3 - Flow, Oseberg, 3 - - # Jet internal - Hephaestus, Namath, 6 - Hephaestus, Xi, 4 - Hephaestus, Lagniappe, 8 - Hephaestus, Dugong, 10 - Namath, Rhinoceros Ridge, 3 - Rhinoceros Ridge, Lagniappe, 2 - Xi, Lagniappe, 5 - Xi, Chaparral, 4 - Xi, Eclipse, 6 - Chaparral, Eclipse, 4 - Lagniappe, Dugong, 3 - Lagniappe, Eclipse, 5 - - # Coral internal and interarch to Jet - Park, Angelfish, 5 - Angelfish, Meke, 4 - Park, Delta, 6 - Delta, Angelfish, 3 - Delta, Macaw, 5 - Macaw, Monsoon, 3 - Monsoon, Chaparral, 6 - Monsoon, Turongo, 4 - Monsoon, Durian, 6 - Turongo, Durian, 3 - Turongo, Angelfish, 7 - Turongo, Delta, 8 - Turongo, Park, 11 - - # Sapphire internal - Remora, The Horseshoe Crabs, 3 - Remora, Beta, 3 - The Horseshoe Crabs, Verdant Atoll, 3 - The Horseshoe Crabs, Beta, 5 - Beta, Iris, 4 - Verdant Atoll, Uxmal, 3 - Verdant Atoll, Iris, 6 - Uxmal, Iris, 4 - Iris, Vernal Equinox, 3 diff --git a/yarrg/pages.c b/yarrg/pages.c index 2e3edde..02cacd9 100644 --- a/yarrg/pages.c +++ b/yarrg/pages.c @@ -156,26 +156,26 @@ static void check_not_disturbed(void) { static void send_key(KeySym sym) { check_not_disturbed(); - XTestFakeKeyEvent(disp, keycode(sym),1, 10); - XTestFakeKeyEvent(disp, keycode(sym),0, 10); + XTestFakeKeyEvent(disp, keycode(sym),1, 0); + XTestFakeKeyEvent(disp, keycode(sym),0, 0); } -static void mouse_1_updown_here(void) { +static void send_mouse_1_updown_here(void) { check_not_disturbed(); - XTestFakeButtonEvent(disp,1,1, 10); - XTestFakeButtonEvent(disp,1,0, 10); + XTestFakeButtonEvent(disp,1,1, 0); + XTestFakeButtonEvent(disp,1,0, 0); } -static void mouse_1_updown(int x, int y) { +static void send_mouse_1_updown(int x, int y) { check_not_disturbed(); int screen= XScreenNumberOfScreen(attr.screen); int xpos, ypos; translate_coords_toroot(x,y, &xpos,&ypos); XTestFakeMotionEvent(disp, screen, xpos,ypos, 0); - mouse_1_updown_here(); + send_mouse_1_updown_here(); } static void pgdown_by_mouse(void) { check_not_disturbed(); debugf("PAGING Mouse\n"); - mouse_1_updown_here(); + send_mouse_1_updown_here(); sync_after_input(); } @@ -350,12 +350,14 @@ static void wait_for_stability(Snapshot **output, " last_input=%f previously=%p `%s'\n", last_input, previously, doing); - double min_interval= 0.025; + double max_interval= 5.000; + double min_interval= 0.100; for (;;) { progress_spinner("%s",doing); double since_last_input= timestamp() - last_input; double this_interval= min_interval - since_last_input; + if (this_interval > max_interval) this_interval= max_interval; if (this_interval >= 0) delay(this_interval); @@ -496,7 +498,7 @@ static void set_focus_commodity(void) { debugf("PAGING set_focus\n"); - mouse_1_updown(commod_focus_point.x, commod_focus_point.y); + send_mouse_1_updown(commod_focus_point.x, commod_focus_point.y); sync_after_input(); delay(0.5); @@ -552,16 +554,17 @@ static void prepare_ypp_client(void) { Rect sunshine= find_sunshine_widget(); progress("poking client..."); - mouse_1_updown((sunshine.tl.x + sunshine.br.x) / 2, - (sunshine.tl.y*9 + sunshine.br.y) / 10); + send_mouse_1_updown((sunshine.tl.x + sunshine.br.x) / 2, + (sunshine.tl.y*9 + sunshine.br.y) / 10); + sync_after_input(); free(test); wait_for_stability(¤t,0,0, "checking basic YPP client screen..."); - mouse_1_updown(250, wheight-10); - mouse_1_updown_here(); - mouse_1_updown_here(); - XSync(disp,False); + send_mouse_1_updown(250, wheight-10); + send_mouse_1_updown_here(); + send_mouse_1_updown_here(); + sync_after_input(); check_not_disturbed(); send_key(XK_slash); send_key(XK_w); @@ -602,37 +605,34 @@ void take_screenshots(void) { for (;;) { debugf("page %d paging\n",npages); + pgdown_by_mouse(); + if (!(npages < MAX_PAGES)) fatal("Paging down seems to generate too many pages - max is %d.", MAX_PAGES); convert_store_page(current); free_snapshot(&last); last=current; current=0; - debugf("PAGING page %d converted\n",npages); + npages++; wait_for_stability(¤t,last, 0, "page %d collecting ...", - npages+1); - - if (npages && /* first pagedown doesn't do much */ - identical(current,last)) { - npages++; + npages); + if (identical(current,last)) { free_snapshot(¤t); break; } - - pgdown_by_mouse(); - npages++; } progress("finishing with the YPP client..."); - mouse_1_updown(commod_focuslast_point.x, commod_focuslast_point.y); + send_mouse_1_updown(commod_focuslast_point.x, commod_focuslast_point.y); sync_after_input(); send_pgdown_torestore(); sync_after_input(); debugf("PAGING all done.\n"); progress_log("collected %d screenshots.",npages); + check_pager_motion(0,npages); } void take_one_screenshot(void) { diff --git a/yarrg/source-info.txt b/yarrg/source-info.txt new file mode 100644 index 0000000..c0e1deb --- /dev/null +++ b/yarrg/source-info.txt @@ -0,0 +1,178 @@ + +commods + kraken's blood 1kg + %c dye 1kg + %c enamel 5kg + %c paint 1200g 1l + + %c cloth 700g + fine %c cloth 700g + sail cloth 700g + +nocommods + black dye + +%c + aqua + black + blue + brown + gold + green + grey + lavender + lemon + light blue + light green + lime + magenta + maroon + mint + navy + orange + peach + persimmon + pink + purple + red + rose + tan + violet + white + yellow + +commods + %g gems 10kg + diamonds 10kg + emeralds 10kg + moonstones 10kg + opals 10kg + pearls 10kg + rubies 10kg + sapphires 10kg + topazes 10kg + +%g + amber + amethyst + beryl + coral + jade + jasper + jet + lapis lazuli + quartz + tigereye + +commods + swill 1kg + grog 1kg + fine rum 1kg + + broom flower 200g + butterfly weed 100g + cowslip 700g + elderberries 700g + indigo 700g + iris root 300g + lily of the valley 300g + lobelia 200g + madder 400g + nettle 300g + old man's beard 800g + pokeweed berries 300g + sassafras 500g + weld 300g + yarrow 200g + + bananas 125kg 100l + coconuts 125kg 100l + limes 125kg 100l + mangos 125kg 100l + pineapples 125kg 100l + + carambolas 125kg 100l + durians 125kg 100l + passion fruit 125kg 100l + pomegranates 125kg 100l + rambutan 125kg 100l + + chalcocite 5700g + cubanite 4700g + gold nuggets 400g + leushite 4400g + lorandite 5500g + masuyite 5100g + papagoite 3300g + serandite 3400g + sincosite 3000g + tellurium 6200g + thorianite 100g + + small cannon balls 7100g + medium cannon balls 14200g 2l + large cannon balls 21300g 3l + + hemp 125kg 250l + hemp oil 1kg + iron 7800g + lacquer 1kg + stone 2600g + sugar cane 50kg 100l + varnish 1kg + wood 175kg 250l + + +client ypp-sc-tools yarrg + lastpage + + +#---------- OCEANS ---------- +# subscriber oceans + +ocean Midnight + +ocean Cobalt + Garnet + Jubilee Island + +ocean Ice + Vilya + Winking Wall Island + +# doubloon oceans + +ocean Hunter + Eagle + Ix Chel + +ocean Malachite + Draco + Cetus Island + Threewood Island + +ocean Sage + Osprey + Scurvy Reef + Gauntlet Island + +ocean Viridian + +# family oceans + +ocean Crimson + +# International oceans (doubloon oceans) + +#ocean Jade +# Cigüeña +# Isla Scrimshaw +# Ibis +# Isla Kiwara +# Águila +# Cayo Escorbuto + +#ocean Opal +# Canis +# Atchafalaya-Insel + diff --git a/yarrg/structure.c b/yarrg/structure.c index f10addc..ba7ba0d 100644 --- a/yarrg/structure.c +++ b/yarrg/structure.c @@ -37,7 +37,7 @@ DEBUG_DEFINE_DEBUGF(struct) struct PageStruct { Rect mr; - int commbasey, comminty; + int commbasey, comminty, pagerheight; int colrightx[INTERESTING_COLUMNS]; }; @@ -313,12 +313,16 @@ void find_structure(const CanonImage *im, #define CHECK_STRIP_BORDER(tlbr,xy,increm) \ do { \ - Point csb_p; \ + Point csb_p, csb_p2; \ Rect csb_r; \ csb_p= s.mr.tl; \ csb_p.x++; csb_p.y++; \ + csb_p2= csb_p; \ + csb_p2.x++; csb_p2.y++; \ csb_p.xy= s.mr.tlbr.xy; \ - if (get_p(csb_p)=='+') { \ + csb_p2.xy= s.mr.tlbr.xy; \ + if (get_p(csb_p)=='+' && \ + get_p(csb_p2)=='+') { \ csb_r= s.mr; \ csb_r.tl.xy= csb_p.xy; \ csb_r.br.xy= csb_p.xy; \ @@ -397,6 +401,13 @@ void find_structure(const CanonImage *im, ADJUST_BOX(pager, "o",>=,RECT_W(pager)-2, s.mr.tl.y,LIMIT_QUITEQ, tl,y,-1); debug_rect("pager",__LINE__,pager); + pager.br.y= pager.tl.y; + pager.tl.y= pager.tl.y-1; + if (pager.tl.y > s.mr.tl.y) + ADJUST_BOX(pager, "+",>,1, s.mr.tl.y,LIMIT_QUITEQ, tl,y,-1); + debug_rect("pager",__LINE__,pager); + s.pagerheight= pager.br.y - pager.tl.y; + #define SET_ONCE(var,val) do{ \ int v= (val); \ if ((var)==-1) (var)= v; \ @@ -426,7 +437,7 @@ void find_structure(const CanonImage *im, } if (commod_page_point_r) { commod_page_point_r->x= (pager.tl.x + pager.br.x) / 2; - commod_page_point_r->y= pager.tl.y - 1; + commod_page_point_r->y= pager.br.y - 1; } MUST( text_h <= OCR_MAX_H, MI(text_h) ); @@ -468,6 +479,19 @@ void check_correct_commodities(void) { "??____X_____?_X_?X__?X_______________________", "???__?_______?__?___?_______________________?", }; + static const char *all_fuzzy[]= { + "???___________________________________???", + "??_______???___X__X____________________??", + "?_______????__?X_?X_____XXXXXXXXXXX_____?", + "________?????_?X_?X______XXXXXXXXX_______", + "________?????_?X_?X_______XXXXXXX________", + "_______??????_?X_?X________XXXXX_________", + "_______??_?????X_?X_________XXX__________", + "______??XXXXX??X_?X__________X___________", + "?_____?????????X_?X______________________", + "??___???____???X_?X______________________", + "???__??_____???__?______________________?", + }; #define COMMOD_SELECTOR_MATCHES(all) \ commod_selector_matches(search, all, \ @@ -475,7 +499,8 @@ void check_correct_commodities(void) { strlen((all)[0])) if (!(COMMOD_SELECTOR_MATCHES(all_small) || - COMMOD_SELECTOR_MATCHES(all_big))) + COMMOD_SELECTOR_MATCHES(all_big) || + COMMOD_SELECTOR_MATCHES(all_fuzzy))) fatal("Commodities selector not set to `All'."); } @@ -529,6 +554,7 @@ void store_current_page(CanonImage *ci, PageStruct *pstruct, RgbImage *rgb) { else free(rgb); page_images[npages]= cim; page_structs[npages]= *pstruct; + debugf("STORED page %d pagerheight=%d\n", npages, pstruct->pagerheight); free(pstruct); } @@ -556,6 +582,12 @@ void read_screenshots(void) { } sysassert(!ferror(screenshot_file)); progress_log("read %d screenshots.",npages); + + check_pager_motion(1,npages); + /* When we are reading screenshots, the pages file contains the + * `determine where we're to click' page as well as the first + * actual data page, which we have to skip. + */ } #define FIXPT_SHIFT 15 @@ -1006,3 +1038,55 @@ void find_islandname(void) { island= masprintf("%s", delim+3); } + +void check_pager_motion(int first, int stop) { + /* We check that the pager moved by an appropriate amount. + * The last gap can be smaller but not bigger. + */ + int count= stop-first; + +#define PH(p) (page_structs[(p)].pagerheight) + + debugf("CHECK_PAGER_MOTION %d..%d count=%d\n", first,stop,count); + + if (count <= 1) return; /* only one page */ + + double firstheight= PH(first); + double max= count>2 ? firstheight / (count-2) : 0; + double min= firstheight / (count-1); + max *= 1.1; + min /= 1.1; + max += 1.0; + min -= 1.0; + debugf("CHECK_PAGER_MOTION min=%g max=%g\n", min,max); + assert(max>min); + + int skips=0, firstskip=1; + int stops=0, firststop=1; + +#define REPORT(skipstop,msg) do{ \ + skipstop##s++; \ + if (first##skipstop<0) first##skipstop= page; \ + if (skipstop##s<5) \ + fprintf(stderr,msg " (page %d)\n",page); \ + }while(0) + + int page; + for (page=first+1; pagemax) + REPORT(skip, "scrollbar motion probable page skip detected!"); + if (gap +# +# 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 . +# +# Yohoho and Puzzle Pirates are probably trademarks of Three Rings and +# are used without permission. This program is not endorsed or +# sponsored by Three Rings. +use strict (qw(vars)); use DBI; - use Commods; -@ARGV==1 or die; -my ($rsyncdir) = @ARGV; +$ENV{'LC_CTYPE'}= 'en_GB.UTF-8'; + +sub full ($) { + my ($ocean) = @_; + quick($ocean); + print "## updating topology of $ocean\n"; + system('./yppedia-chart-parser',$ocean); die "$ocean $?" if $?; + print "\n"; +} + +sub quick ($) { + my ($ocean) = @_; + print STDERR "## updating schema and commodities for $ocean\n"; + system('./db-idempotent-populate',$ocean); die $? if $?; +} + +my $rsyncdir; + +sub process_some_info ($$$) { + my ($v,$df,$sfn) = @_; + my $sf= new IO::File $sfn or die "$sfn $!"; + + my $h; + while (<$sf>) { + chomp; s/\s+$//; + next if m/^\s*\#/ || !m/\S/; + if (m/^\S.*/) { + $h= $&; + } + die "$_ ?" unless defined $h; + if ($h =~ m/^commods|^\%[a-z]\b/) { + s/\t.*//; + } + if ($v<2) { + next if $h =~ m/^nocommods/; + } + next if $sfn =~ m/source-info/ && $h =~ m/^ocean\b/; + next if $h =~ m/^client\b/; + + print $df $_, "\n" or die $!; + } + + $sf->error and die $!; +} + +sub update_master_info () { + foreach my $v (1..$masterinfoversion) { + my $dfnl= sprintf "master-info%s.txt", ($v>1 ? "-v$v" : ''); + print STDERR "installing new $dfnl...\n"; + + my $dfn= "$rsyncdir/$dfnl"; + my $df= new IO::File "$dfn.tmp", 'w' or die "$dfn.tmp $!"; + + process_some_info($v,$df, 'source-info.txt'); + foreach my $ocean (sort keys %oceans) { + process_some_info($v,$df, '_ocean-'.(lc $ocean).'.txt'); + } + + close $df or die $!; + rename "$dfn.tmp", "$dfn" or die $!; + } +} + + +my @specoceans; +my $alloceans; + +sub optarg () { + return $_ if length; + die unless @ARGV; + return scalar shift @ARGV; +} + +while (@ARGV && $ARGV[0] =~ m/^-/) { + $_= shift @ARGV; + last if m/^--?$/; + while (m/^-./) { + if (s/^-d//) { + die if defined $rsyncdir; + $rsyncdir= optarg(); + } elsif (s/^-O//) { + push @specoceans, optarg(); + } elsif (s/^-a//) { + die if $alloceans; + $alloceans=1; + } else { + die "$_ ?"; + } + } +} +die if @ARGV; + +die if @specoceans && $alloceans; parse_info_serverside(); -foreach my $oceanname (sort keys %oceans) { - print STDERR "updating ocean $oceanname...\n"; - system('./db-idempotent-populate',$oceanname); die $? if $?; +if (@specoceans) { + print "### full update of specified oceans ...\n"; + foreach my $ocean (@specoceans) { + die "$ocean ?" unless defined $oceans{$ocean}; + full($ocean); + } +} elsif ($alloceans) { + print "### full (inc.topology) update of all oceans ...\n"; + foreach my $ocean (sort keys %oceans) { + full($ocean); + } +} else { + print "### quick (no topology) update only (of all oceans) ...\n"; + foreach my $ocean (sort keys %oceans) { + quick($ocean); + } } -print STDERR "installing new master-info...\n"; -my $df= "$rsyncdir/master-info.txt"; -system('cp','--','master-info.txt',"$df.tmp"); die $? if $?; -system('mv','--',"$df.tmp",$df); die $? if $? +if (defined $rsyncdir) { + print "### master-info update ...\n"; + update_master_info(); +} diff --git a/yarrg/web/.perl-lib b/yarrg/web/.perl-lib new file mode 120000 index 0000000..a96aa0e --- /dev/null +++ b/yarrg/web/.perl-lib @@ -0,0 +1 @@ +.. \ No newline at end of file diff --git a/yarrg/web/autohandler b/yarrg/web/autohandler new file mode 100644 index 0000000..7344f07 --- /dev/null +++ b/yarrg/web/autohandler @@ -0,0 +1,57 @@ +<%doc> + + This is part of the YARRG website. YARRG is a tool and website + for assisting players of Yohoho Puzzle Pirates. + + Copyright (C) 2009 Ian Jackson + Copyright (C) 2009 Clare Boothby + + YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later). + The YARRG website is covered by the GNU Affero GPL v3 or later, which + basically means that every installation of the website will let you + download the source. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as + published by the Free Software Foundation, either version 3 of the + License, or (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . + + Yohoho and Puzzle Pirates are probably trademarks of Three Rings and + are used without permission. This program is not endorsed or + sponsored by Three Rings. + + + This Mason autohandler contains the doctype, charset and + copyright message. + + + + + +% $m->call_next; + +<%init> +use CommodsWeb; +set_ctype_utf8(); +$r->content_type('text/html; charset=UTF-8'); + diff --git a/yarrg/web/check b/yarrg/web/check new file mode 100755 index 0000000..56a1be1 --- /dev/null +++ b/yarrg/web/check @@ -0,0 +1,7 @@ +Stuff +
+@INC = <% join ':', @INC |h %>
+% foreach my $e (sort keys %ENV) {
+<% $e |h%>=<% $ENV{$e} |h%>
+% }
+
diff --git a/yarrg/web/check_commodstring b/yarrg/web/check_commodstring
new file mode 100644
index 0000000..de7cda8
--- /dev/null
+++ b/yarrg/web/check_commodstring
@@ -0,0 +1,58 @@
+<%doc>
+
+ This is part of the YARRG website.  YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson 
+ Copyright (C) 2009 Clare Boothby
+
+  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+  The YARRG website is covered by the GNU Affero GPL v3 or later, which
+   basically means that every installation of the website will let you
+   download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program.  If not, see .
+
+ Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+ are used without permission.  This program is not endorsed or
+ sponsored by Three Rings.
+
+
+ This Mason component simply defines how to look up commodities.
+ It is called by qtextstring.
+
+
+
+<%attr>
+multiple => 0
+maxambig => 4
+
+
+<%method sqlstmt>
+SELECT commodname,commodid
+	FROM commods WHERE commodname LIKE ?
+
+
+<%method nomatch>
+  no commodity matches "<% $ARGS{spec} |h %>"
+
+
+<%method ambiguous>
+  ambiguous commodity "<% $ARGS{spec} |h %>",
+  could be <% $ARGS{couldbe} |h %>
+
+
+<%method manyambig>
+  Many matching commodities.
+
diff --git a/yarrg/web/check_routestring b/yarrg/web/check_routestring
new file mode 100644
index 0000000..cfa7ec7
--- /dev/null
+++ b/yarrg/web/check_routestring
@@ -0,0 +1,60 @@
+<%doc>
+
+ This is part of the YARRG website.  YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson 
+ Copyright (C) 2009 Clare Boothby
+
+  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+  The YARRG website is covered by the GNU Affero GPL v3 or later, which
+   basically means that every installation of the website will let you
+   download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program.  If not, see .
+
+ Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+ are used without permission.  This program is not endorsed or
+ sponsored by Three Rings.
+
+
+ This Mason component simply defines how to look up route entries.
+ It is called by qtextstring.
+
+
+
+<%attr>
+multiple => 1
+maxambig => 5
+
+
+<%method sqlstmt>
+		SELECT islandname,islandid,archipelago
+			FROM islands WHERE islandname LIKE ?
+UNION ALL	SELECT DISTINCT archipelago,NULL,archipelago
+			FROM islands WHERE archipelago LIKE ?
+
+
+<%method nomatch>
+  no island or arch matches "<% $ARGS{spec} |h %>"
+
+
+<%method ambiguous>
+  ambiguous island or arch "<% $ARGS{spec} |h %>",
+  could be <% $ARGS{couldbe} |h %>
+
+
+<%method manyambig>
+   
+
diff --git a/yarrg/web/copyrightdate b/yarrg/web/copyrightdate
new file mode 100644
index 0000000..e7d2dc8
--- /dev/null
+++ b/yarrg/web/copyrightdate
@@ -0,0 +1 @@
+Copyright 2009 Ian Jackson, Clare Boothby
\ No newline at end of file
diff --git a/yarrg/web/dhandler b/yarrg/web/dhandler
new file mode 100644
index 0000000..2cdb09c
--- /dev/null
+++ b/yarrg/web/dhandler
@@ -0,0 +1,13 @@
+<%perl>
+my $arg= $m->dhandler_arg;
+if ($arg =~ m,^/?$,) {
+	$m->redirect('lookup');
+} else {
+	$r->header_out('Status','404 Not found');
+
+Page not found - YARRG
+
404 YARRG component not found

+<% $arg |h %>
+<%perl>
+}
+
diff --git a/yarrg/web/docs b/yarrg/web/docs
new file mode 100755
index 0000000..0ea31cf
--- /dev/null
+++ b/yarrg/web/docs
@@ -0,0 +1,138 @@
+<%doc>
+
+ This is part of the YARRG website.  YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson 
+ Copyright (C) 2009 Clare Boothby
+
+  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+  The YARRG website is covered by the GNU Affero GPL v3 or later, which
+   basically means that every installation of the website will let you
+   download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program.  If not, see .
+
+ Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+ are used without permission.  This program is not endorsed or
+ sponsored by Three Rings.
+
+
+ This Mason component generates the documentation.
+
+
+
+YARRG (Yet Another Revenue Research Gatherer)
+
+
+
Introduction to YARRG

+
+YARRG (Yet Another Revenue Research Gatherer) is a third-party tool
+for helping find profitable trades and trade routes in Yohoho Puzzle
+Pirates.  It was inspired by
+PCTB.
+
+

+
+The system has two main parts: this website which maintains a
+searchable database of commodity prices, and an upload client, which
+screenscrapes the commodity data from the Puzzle Pirates game client
+and uploads it to the database.
+
+
Market prices database

+
+The lookup page gives access to the uploaded data.
+
+
Uploading from Linux

+
+The YARRG upload client uploads both to YARRG and to the
+PCTB testing server.
+
+

+
+The current official version of YARRG for use as an upload
+client can browsed here:
+ http://www.chiark.greenend.org.uk/~ijackson/ypp-sc-tools/master/
+See particularly the
+YARRG README.
+
+

+To install the client, install the `git' version control system
+and the other dependencies listed in the `Installation requirements'
+section of the README and then run:
+
+git-clone http://www.chiark.greenend.org.uk/~ijackson/ypp-sc-tools/master/.git ypp-sc-tools
+cd ypp-sc-tools
+cd yarrg
+make
+

+this will download the code into the directory ypp-sc-tools,
+and build the software.
+
+

+
+When new versions of the upload client are released, you can:
+
+cd .../ypp-sc-tools
+git-pull
+cd yarrg
+make
+

+to fetch the new version.
+
+
Uploading from Windows

+
+There is not currently an upload client for Windows which feeds data
+into YARRG.  It would probably be straightforward to modify the
+Windows PCTB v5 upload client to upload to YARRG as well.  The
+mechanism and format for uploading is documented in
+README.devel.
+
+
YARRG development, contribution and troubleshooting

+
+
Free Software (aka Open Source)

+
+YARRG is Free Software - you may share and modify it.  See the
+licences for details.
+
+

+
+Not only the client but also the webserver code is Free.  The website
+code can be found in the same tree as above, in the web
+directory.
+
+

+
+But in case we have made changes but not yet pushed them
+(perhaps because we haven't done a release), and to make it easy for
+anyone else who runs a copy of the website to provide everyone with
+the source for their version, the website code itself lets you download
+an up-to-date tarball of its
+actually-running source code.
+
+

+
+If you would like to run a (perhaps modified) copy of the YARRG
+website it would be very easy for us to make our system send you
+copies of updates submitted by users of the official YARRG client, in
+the format expected by the code you'll be running.  Please just ask
+us.
+
+
Contacting the YARRG developers

+
+Email Ian Jackson ijackson (at) chiark.greenend.org.uk.  Or talk to
+any Fleet Officer or above of the crew Special Circumstances on the
+Midnight Ocean.
+
+<& footer, isdocs => 1 &>
diff --git a/yarrg/web/dumptable b/yarrg/web/dumptable
new file mode 100644
index 0000000..e60415c
--- /dev/null
+++ b/yarrg/web/dumptable
@@ -0,0 +1,117 @@
+<%doc>
+
+ This is part of the YARRG website.  YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson 
+ Copyright (C) 2009 Clare Boothby
+
+  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+  The YARRG website is covered by the GNU Affero GPL v3 or later, which
+   basically means that every installation of the website will let you
+   download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program.  If not, see .
+
+ Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+ are used without permission.  This program is not endorsed or
+ sponsored by Three Rings.
+
+
+ This Mason component is helpful for debugging and developing.  It
+ outputs plain HTML tables eg for SQL query results.  You can either:
+    <& dumptable, sth = $executed_statement_handle &>
+ in which case it will consume the results of the statement and
+ print them unconditionally, or do the equivalent of:
+    <& dumptable:start, sth => $sth,              [ qa => $qa ] &> or
+    <& dumptable:start, cols => [ 'column',... ], [ qa => $qa ] &>
+    %	my $row;
+    %	while ($row= $sth->fetchrow_hashref) {
+    <& dumptable:row, sth|cols => ..., row => $row, [ qa => $qa ] &>
+    %       do something else with $row
+    %	}
+    <& dumptable:end, [ qa => $qa ] &>
+ where if you pass $qa, dumptable will check whether debug
+ is enabled and produce no output if it isn't.  NB you don't want
+ this approach if your loop body produces output because it'll be
+ interleaved with dumptable's table.
+
+
+<%args>
+$sth
+
+
+<%method start>
+<%args>
+$sth => undef
+$cols => $sth->{NAME}
+$qa => undef
+
+%	if (!$qa || $qa->{'debug'}) {
+
+
+%		foreach my $field (@$cols) {
+
+%	}
+
+
+<%method row>
+<%args>
+$sth => undef
+$cols => $sth->{NAME}
+$row
+$qa => undef
+
+%	if (!$qa || $qa->{'debug'}) {
+
+%		foreach my $field (@$cols) {
+%			my $cell= $row->{$field};
+
+%		}
+
+%	}
+
+
+<%method end>
+<%args>
+$qa => undef
+
+%	if (!$qa || $qa->{'debug'}) {
+
<% $field |h %>
+%		}
+

+<% $cell |h %>
+

+%	}
+
+
+<%method literal>
+<%args>
+$cols
+$rows
+$qa => undef
+
+<& SELF:start, cols => $cols &>
+%	foreach my $row (@$rows) {
+<& SELF:row, cols => $cols, row => $row &>
+%	}
+<& SELF:end &>
+
+
+<& SELF:start, sth => $sth &>
+%	my $row;
+%	while ($row= $sth->fetchrow_hashref) {
+<& SELF:row, sth => $sth, row => $row &>
+%	}
+<& SELF:end &>
diff --git a/yarrg/web/footer b/yarrg/web/footer
new file mode 100644
index 0000000..8af45ad
--- /dev/null
+++ b/yarrg/web/footer
@@ -0,0 +1,62 @@
+<%doc>
+
+ This is part of the YARRG website.  YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson 
+ Copyright (C) 2009 Clare Boothby
+
+  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+  The YARRG website is covered by the GNU Affero GPL v3 or later, which
+   basically means that every installation of the website will let you
+   download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program.  If not, see .
+
+ Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+ are used without permission.  This program is not endorsed or
+ sponsored by Three Rings.
+
+
+ This Mason component is simply the page footer.
+
+
+
+<%args>
+$isdocs => 0
+
+

+

+YARRG is Yet Another Revenue Research Gatherer, a project of the
+crew Special Circumstances on the Midnight Ocean
+and of the Sinister Greenend Organisation.
+

+
+YARRG is Free Software.
+You may share and modify the code and the
+website, according to the terms of the GNU General Public Licence and
+the GNU Affero General Public Licence respectively (v3 or later).
+% if (!$isdocs) {
+Please see the YARRG documentation webpage for
+details of how to obtain the client and server code and full details
+of the licences.
+% }
+
+

+YARRG is <& copyrightdate &>.
+Yohoho and Puzzle Pirates are trademarks of Three Rings and are used
+without permission.  YARRG is not endorsed or sponsored by Three
+Rings.
+
+

diff --git a/yarrg/web/lookup b/yarrg/web/lookup
new file mode 100755
index 0000000..8fb3bb1
--- /dev/null
+++ b/yarrg/web/lookup
@@ -0,0 +1,288 @@
+<%doc>
+
+ This is part of the YARRG website.  YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson 
+ Copyright (C) 2009 Clare Boothby
+
+  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+  The YARRG website is covered by the GNU Affero GPL v3 or later, which
+   basically means that every installation of the website will let you
+   download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program.  If not, see .
+
+ Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+ are used without permission.  This program is not endorsed or
+ sponsored by Three Rings.
+
+
+ This Mason component generates the main `lookup' page, including
+ all the entry boxes etc. for every query.
+
+
+
+<%perl>
+my %ahtml;
+my @vars;
+my %styles;
+
+#---------- "mode" argument parsing and mode menu at top of page ----------
+
+# for debugging, invoke as
+#  http://www.chiark.greenend.org.uk/ucgi/~clareb/mason/pirates/pirate-route?debug=1
+
+@vars= ({	Name => 'Ocean',
+		Before => 'Ocean: ',
+		CmpCanon => sub { ucfirst lc $_[0] },
+		Values => [ ocean_list() ]
+	}, {	Name => 'Dropdowns',
+		Before => 'Interface: ',
+		CmpCanon => sub { !!$_[0] },
+		Values => [	[ 0, 'Type in names' ],
+				[ 4, 'Select from menus' ] ]
+	}, {	Name => 'Query',
+		Before => 'Query: ',
+		Values => [	[ 'route', 'Trades for route' ],
+				[ 'commod', 'Prices for commodity' ],
+				[ 'age', 'Data age' ] ]
+	}, {	Name => 'BuySell',
+		Before => '',
+		Values => [	[ 'buy_sell',	'Buy and sell' ],
+				[ 'sell_buy',	'Sell and buy' ],
+				[ 'buy',	'Buy offers only' ],
+				[ 'sell',	'Sell offers only' ],
+			],
+		QuerySpecific => 1,
+	}, {	Name => 'ShowBlank',
+		Before => '',
+		Values => [	[ 0, 'Omit islands with no offers' ],
+				[ 'show', 'Show all islands' ],
+			],
+		QuerySpecific => 1,
+	}, {	Name => 'ShowStalls',
+		Before => '',
+		Values => [	[ 0, 'Show total quantity at each price' ],
+				[ 1, 'Show individual stalls' ],
+			],
+		QuerySpecific => 1,
+	});
+
+foreach my $var (@vars) {
+	my $name= $var->{Name};
+	my $lname= lc $name;
+	$var->{Before}= '' unless exists $var->{Before};
+	$var->{CmpCanon}= sub { $_[0]; } unless exists $var->{CmpCanon};
+	foreach my $val (@{ $var->{Values} }) {
+		next if ref $val;
+		$val= [ $val, encode_entities($val) ];
+	}
+	if (exists $ARGS{$lname}) {
+		$styles{$name}= $ARGS{$lname};
+		my @html= grep { $_->[0] eq $styles{$name} }
+				@{ $var->{Values} };
+		$ahtml{$name}= @html==1 ? $html[0][1] : '???';
+	} else {
+		$styles{$name}= $var->{Values}[0][0];
+		$ahtml{$name}= $var->{Values}[0][1];
+	}
+}
+
+
+
+<%shared>
+my %baseqf;
+my %queryqf;
+
+
+<%method formhidden>
+<%args>
+$ours
+
+% foreach my $n (keys %baseqf, keys %queryqf) {
+%	next if $ours->($n);
+%	my $v= exists $baseqf{$n} ? $baseqf{$n} : $queryqf{$n};
+ value="<% $v |h %>">
+% }
+
+
+<% ucfirst $ahtml{Query} %> - YARRG
+
+<&| script &>
+  function register_onload(f) {
+    var previous_onload= window.onload;
+    window.onload= function() {
+      if (previous_onload) previous_onload();
+      f();
+    };
+  }
+
+
+
+YARRG -
+ Yet Another Revenue Research Gatherer
+|
+documentation
+

+<%perl>
+
+foreach my $var (@vars) {
+	my $lname= lc $var->{Name};
+	next unless exists $ARGS{$lname};
+	$baseqf{$lname}= $ARGS{$lname};
+}
+
+foreach my $var (keys %ARGS) {
+	next unless $var =~
+		m/^(?: (?:route|commod)string |
+			commodid |
+			islandid \d |
+			archipelago \d |
+			debug |
+			[RT]\w+
+		    )$/x;
+	my $val= $ARGS{$var};
+	next if $val eq 'none';
+	$queryqf{$var}= $val;
+}
+
+my $quri= sub {
+	my $uri= URI->new('lookup');
+	$uri->query_form(@_);
+	$uri->path_query();
+};
+
+my $prselector_core= sub {
+	my ($var)= @_;
+	my $name= $var->{Name};
+	my $lname= lc $var->{Name};
+	my $delim= $var->{Before};
+	my $canon= &{$var->{CmpCanon}}($styles{$name});
+	my $cvalix= 0;
+	foreach my $valr (@{ $var->{Values} }) {
+		print $delim;  $delim= "\n|\n";
+		my ($value,$html) = @$valr;
+		my $iscurrent= &{$var->{CmpCanon}}($value) eq $canon;
+		my $after;
+		if ($iscurrent) {
+			print '';
+			$after= '';
+		} else {
+			my %qf= (%baseqf,%queryqf);
+			delete $qf{$lname};
+			$qf{$lname}= $value if $cvalix;
+
+
+<%perl>
+			$after= '';
+		}
+		print $html, $after;
+		$cvalix++;
+	}
+	print "
\n\n";
+};
+
+my $prselector= sub {
+	my ($name)= @_;
+	foreach my $var (@vars) {
+		if ($var->{Name} eq $name) {
+			$prselector_core->($var);
+			return;
+		}
+	}
+	die $name;
+};
+
+foreach my $var (@vars) {
+	next if $var->{QuerySpecific};
+	$prselector_core->($var);
+}
+
+#---------- initial checks, startup, main entry form ----------
+
+die if $styles{Query} =~ m/[^a-z]/;
+
+my $mydbh;
+my $dbh= ($mydbh= dbw_connect($styles{Ocean}));
+
+my $results_head_done=0;
+my $someresults= sub {
+	return if $results_head_done;
+	$results_head_done=1;
+	my ($h)= @_;
+	$h= 'Results' if !$h;
+	print "\n
$h
\n";
+};
+
+
+<%args>
+$debug => 0
+
+
+

+
+<& "query_$styles{Query}", %baseqf, %queryqf, %styles,
+    quri => $quri, dbh => $dbh,
+    prselector => $prselector,
+    someresults => $someresults,
+    emsgokorprint => sub {
+	my ($emsg) = @_;
+	return 1 unless defined $emsg and length $emsg;
+	$someresults->();
+	print $emsg;
+	return 0;
+    }
+ &>
+
+

+
+%#---------- debugging and epilogue ----------
+
+% if ($debug) {
+

+
+Debug log:
+

+% }
+
+<&| script &>
+function debug (m) {
+% if ($debug) {
+  var node= document.getElementById('debug_log');
+  node.innerHTML += "\n" + m + "\n";
+% }
+}
+
+
+<& footer &>
+
+<%init>
+use CommodsWeb;
+use HTML::Entities;
+use URI::Escape;
+
+
+<%cleanup>
+
+$mydbh->rollback() if $mydbh;
+
+
diff --git a/yarrg/web/pirate-island b/yarrg/web/pirate-island
new file mode 100755
index 0000000..67b4cfb
--- /dev/null
+++ b/yarrg/web/pirate-island
@@ -0,0 +1,22 @@
+Select island
+

+
+

+
+<%init>
+use CommodsWeb;
+db_setocean('Midnight');
+db_connect();
+
diff --git a/yarrg/web/profitable_trades b/yarrg/web/profitable_trades
new file mode 100644
index 0000000..313a04a
--- /dev/null
+++ b/yarrg/web/profitable_trades
@@ -0,0 +1,34 @@
+
+
+test pirate page
+
+
+
+Profitable trades
+<%perl>
+my $sth=$dbh->prepare(
+    "SELECT commods.commodname,
+            sell_islands.islandname,sell_stalls.stallname,sell.price,sell.qty,
+            buy_islands.islandname,buy_stalls.stallname,buy.price,buy.qty
+     FROM commods
+     JOIN buy on commods.commodid=buy.commodid
+     JOIN sell on commods.commodid=sell.commodid
+     JOIN islands as buy_islands  on buy.islandid  = buy_islands.islandid
+     JOIN stalls  as buy_stalls   on buy.stallid   = buy_stalls.stallid
+     JOIN islands as sell_islands on sell.islandid = sell_islands.islandid
+     JOIN stalls  as sell_stalls  on sell.stallid  = sell_stalls.stallid
+     WHERE buy.islandid like '36' and sell.islandid like '5'
+     and buy.price > sell.price
+     ");
+
+$sth->execute();
+
+<& dumptable, sth => $sth &>
+
+
+
+
+<%init>
+use CommodsWeb;
+my $dbh= dbw_connect('Midnight');
+
diff --git a/yarrg/web/qtextstring b/yarrg/web/qtextstring
new file mode 100644
index 0000000..84564df
--- /dev/null
+++ b/yarrg/web/qtextstring
@@ -0,0 +1,115 @@
+<%doc>
+
+ This is part of the YARRG website.  YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson 
+ Copyright (C) 2009 Clare Boothby
+
+  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+  The YARRG website is covered by the GNU Affero GPL v3 or later, which
+   basically means that every installation of the website will let you
+   download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program.  If not, see .
+
+ Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+ are used without permission.  This program is not endorsed or
+ sponsored by Three Rings.
+
+
+ This Mason component handles analysis of text string entries, including
+ both the AJAX calls from web page javascript and the entry validation
+ and processing calls from other components.
+
+
+
+<%args>
+$qa => $m->caller_args(1)->{'qa'}
+$dbh
+$thingstring
+$emsgstore
+$perresult
+
+<%perl>
+my $stringval= $qa->{$thingstring};
+$stringval='' if !defined $stringval;
+
+
+<&| script &>
+ts_uri= "qtextstringcheck?format=application/json&ctype=text/xml"
+		+ "&what=<% $thingstring %>"
+		+ "&ocean=<% uri_escape($qa->{Ocean}) %>";
+
+ts_timeout=false;
+ts_request=false;
+ts_done='';
+ts_needed='';
+function ts_Later(){
+  window.clearTimeout(ts_timeout);
+  ts_timeout = window.setTimeout(ts_Needed, 500);
+}
+function ts_Needed(){
+  window.clearTimeout(ts_timeout);
+  ts_element= document.getElementById('<% $thingstring %>');
+  ts_needed= ts_element.value;
+  ts_Request();
+}
+function ts_Request(){
+  if (ts_request || ts_needed==ts_done) return;
+  ts_done= ts_needed;
+  ts_request= new XMLHttpRequest();
+  uri= ts_uri+'&string='+encodeURIComponent(ts_needed);
+  ts_request.open('GET', uri);
+  ts_request.onreadystatechange= ts_Ready;
+  ts_request.send(null);
+}
+function ts_Ready() {
+  if (ts_request.readyState != 4) return;
+  if (ts_request.status == 200) {
+    response= ts_request.responseText;
+    debug('got '+response);
+    eval('results='+response);
+    toedit= document.getElementById('ts_results');
+    toedit.innerHTML= results.show;
+  }
+  ts_request= false;
+  ts_Request();
+}
+register_onload(ts_Needed);
+
+
+content %>
+ id="<% $thingstring %>" name="<% $thingstring %>"
+ onchange="ts_Needed();" onkeyup="ts_Later();"
+ value="<% $stringval |h %>"
+ >
+

+
 


+
+<%perl>
+if (length $thingstring) {
+	my ($emsg,$canonstring,$results)= $m->comp('qtextstringcheck',
+		what => $thingstring,
+		ocean => $qa->{Ocean},
+		string => $stringval,
+		format => 'return'
+	);
+	$$emsgstore= $emsg;
+
+	foreach my $entry (@$results) {
+		$perresult->(@$entry);
+	}
+}
+
diff --git a/yarrg/web/qtextstringcheck b/yarrg/web/qtextstringcheck
new file mode 100755
index 0000000..b2c1013
--- /dev/null
+++ b/yarrg/web/qtextstringcheck
@@ -0,0 +1,130 @@
+<%doc>
+
+ This is part of the YARRG website.  YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson 
+ Copyright (C) 2009 Clare Boothby
+
+  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+  The YARRG website is covered by the GNU Affero GPL v3 or later, which
+   basically means that every installation of the website will let you
+   download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program.  If not, see .
+
+ Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+ are used without permission.  This program is not endorsed or
+ sponsored by Three Rings.
+
+
+ This Mason component handles the generic output format options for
+ text string parsers/checkers like check_routestring.
+
+# typical url for this script:
+#  http://www.chiark.greenend.org.uk/ucgi/~clareb/mason/pirates/qtextstring?what=routestring?format=json&ocean=Midnight&string=d
+
+
+
+<%args>
+$ocean
+$format
+$ctype => undef
+$string
+$what
+$dbh => undef
+
+
+<%flags>
+inherit => undef
+
+<%perl>
+
+use JSON;
+use Data::Dumper;
+use HTML::Entities;
+use CommodsWeb;
+
+die if $what =~ m/[^a-z]/;
+my $chk= $m->fetch_comp("check_${what}");
+
+my $mydbh;
+$dbh ||= ($mydbh= dbw_connect($ocean));
+
+my $sqlstmt= $chk->scall_method("sqlstmt");
+my $sth= $dbh->prepare($sqlstmt);
+my @sqlstmt_qs= $sqlstmt =~ m/\?/g;
+
+#die "$sqlstmt @sqlstmt_qs";
+
+my $emsg= '';
+my @results;
+
+my @specs= $chk->attr('multiple') ? (split m#[/|,]#, $string) : ($string);
+
+no warnings qw(exiting);
+
+foreach my $each (@specs) {
+	$each =~ s/^\s*//;  $each =~ s/\s*$//;  $each =~ s/\s+/ /g;
+	next if !length $each;
+	my $err= sub { $emsg= $_[0]; last; };
+	my %m;
+	my $results;
+	foreach my $pat ("$each", "$each\%", "\%$each\%") {
+		$sth->execute(($pat) x @sqlstmt_qs);
+		$results= $sth->fetchall_arrayref();
+		last if @$results==1;
+		map { $m{ $_->[0] }=1 } @$results;
+		$results= undef;
+	}
+	if (!$results) {
+		if (!%m) {
+			$err->($chk->scall_method("nomatch",
+				spec => $each));
+		} elsif (keys(%m) > $chk->attr('maxambig')) {
+			$err->($chk->scall_method("manyambig"));
+		} else {
+			$err->($chk->scall_method("ambiguous",
+				spec => $each,
+			        couldbe => join(', ', sort keys %m)));
+		}
+	}
+	push @results, $results->[0];
+};
+
+$emsg='' if !defined $emsg;
+my $canontext= join ' | ', map { $_->[0] } @results;
+
+if ($format =~ /json/) {
+	$r->content_type($ctype or $format);
+	my $jobj= {
+		success => 1*!length $emsg,
+		show => (length $emsg      ? $emsg                       :
+			 length $canontext ? encode_entities($canontext) :
+                                             ' '),
+	};
+	print to_json_shim($jobj);
+}
+if ($format =~ /dump/) {
+	$r->content_type('text/plain');
+	print Dumper($emsg, $canontext, \@results);
+}
+
+$mydbh->rollback() if $mydbh;
+
+return  $emsg,
+	$canontext,
+	[ @results ];
+
+
diff --git a/yarrg/web/query_age b/yarrg/web/query_age
new file mode 100644
index 0000000..a02187e
--- /dev/null
+++ b/yarrg/web/query_age
@@ -0,0 +1,133 @@
+<%doc>
+
+ This is part of the YARRG website.  YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson 
+ Copyright (C) 2009 Clare Boothby
+
+  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+  The YARRG website is covered by the GNU Affero GPL v3 or later, which
+   basically means that every installation of the website will let you
+   download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program.  If not, see .
+
+ Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+ are used without permission.  This program is not endorsed or
+ sponsored by Three Rings.
+
+
+ This Mason component generates the core of the `data age' query.
+
+
+
+
+<%args>
+$quri
+$dbh
+
+
+<%once>
+
+
+
+<%perl>
+my $now= time;
+
+my $row;
+my $sth= $dbh->prepare("SELECT archipelago, islandid, islandname, timestamp
+				FROM uploads NATURAL JOIN islands
+				ORDER BY archipelago, islandid");
+$sth->execute();
+
+
+
+<&| script &>
+  da_pageload= Date.now();
+
+
+
Market data age

+
+
+
+
+% my %da_ages;
+% my %ts_sortkeys;
+% $da_ages{'id_loaded'}= 0;
+% my $rowix= 0;
+% while ($row=$sth->fetchrow_hashref) {
+%	my $rowid= "id_$row->{'islandid'}";
+%	my $cellid= "c$rowid";
+%	my $age= $now - $row->{'timestamp'};
+%	$ts_sortkeys{'0'}{$rowid}= $row->{'archipelago'};
+%	$ts_sortkeys{'1'}{$rowid}= $row->{'islandname'};
+%	$da_ages{$rowid}= $age;
+ class="<% 'datarow'.($rowix & 1) %>"
+   > 
+%	$rowix++;
+% }
+
Archipelago
+Island
+Age
+
<% $row->{'archipelago'} |h
+  %> <% $row->{'islandname'} |h
+  %> <% prettyprint_age($age) %> 

+
+<& SELF:dataages, id2age => \%da_ages, elemidprefix => "'c'+" &>
+<%method dataages>
+<%args>
+  $id2age
+  $elemidprefix => ''
+
+<&| script &>
+  function da_Refresh() {
+    var now= Date.now();
+    debug('updating now='+now);
+    for (var ageid in da_ages) {
+      var oldage= da_ages[ageid];
+      var el= document.getElementById(<% $elemidprefix %>ageid);
+      var age= oldage + (now - da_pageload) / 1000;
+      var newhtml= <% meta_prettyprint_age('age','Math.floor','+') %>;
+      el.innerHTML= newhtml;
+    }
+  }
+  da_ages= <% to_json_protecttags($id2age) %>;
+  window.setInterval(da_Refresh, 10000);
+  register_onload(da_Refresh);
+
+
+
+<&| tabsort, table => 'ts_table', rowclass => 'datarow', cols => [
+	{}, {},
+	{ DoReverse => 1,
+	  Numeric => 1,
+	  SortKey => "da_ages[rowid]" }]
+  &>
+  ts_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>;
+
+
+

+Time since this page loaded:
+(not known; times above not updating)
+
+

+
+<& "lookup:formhidden", ours => sub { 0; } &>
+

+
+<%init>
+use POSIX;
+use CommodsWeb;
+
diff --git a/yarrg/web/query_commod b/yarrg/web/query_commod
new file mode 100644
index 0000000..b37fa39
--- /dev/null
+++ b/yarrg/web/query_commod
@@ -0,0 +1,233 @@
+<%doc>
+
+ This is part of the YARRG website.  YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson 
+ Copyright (C) 2009 Clare Boothby
+
+  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+  The YARRG website is covered by the GNU Affero GPL v3 or later, which
+   basically means that every installation of the website will let you
+   download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program.  If not, see .
+
+ Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+ are used without permission.  This program is not endorsed or
+ sponsored by Three Rings.
+
+
+ This Mason component generates the core of the `commodity' query.
+
+
+
+<%args>
+$quri
+$dbh
+$commodid => undef;
+$commodstring => '';
+$prselector
+$someresults
+$emsgokorprint
+
+
+<%perl>
+my $emsg;
+my ($commodname,$cmid);
+
+my $qa= \%ARGS;
+
+
+
Commodity enquiry

+
+% $prselector->('BuySell');
+% $prselector->('ShowBlank');
+
+

+
+%#---------- textbox, user enters route as string ----------
+% if (!$qa->{Dropdowns}) {
+
+Enter commodity (abbreviations are OK):

+
+<&| qtextstring, qa => $qa, dbh => $dbh,
+    thingstring => 'commodstring', emsgstore => \$emsg,
+    perresult => sub { ($commodname,$cmid)= @_; }
+ &>
+ size=80
+
+
+% } else { #---------- dropdowns, user selects from menus ----------
+
+%	my $sth= $dbh->prepare("SELECT commodname,commodid FROM commods
+%					ORDER BY commodname");
+%	$sth->execute();
+%	my $row;
+
+
+% } #---------- end of dropdowns, now common middle of page code ----------
+
+
+% my $ours= sub { $_[0] =~ m/^commodstring|^commodid/; };
+<& "lookup:formhidden", ours => $ours &>
+
+

+
+%#========== results ==========
+<%perl>
+
+$emsgokorprint->($emsg) or $cmid=undef;
+return unless defined $cmid;
+$someresults->();
+
+#---------- actually compute the results and print them ----------
+
+foreach my $bs (split /_/, $ARGS{BuySell}) {
+	$bs =~ m/^(buy|sell)$/ or die;
+	$bs= $1;
+	my ($ascdesc) = ($bs eq 'buy')
+		? ('DESC')
+		: ('ASC');
+	my $joinkind= $ARGS{ShowBlank} ? 'LEFT OUTER JOIN' : 'INNER JOIN';
+	my $islands= $dbh->prepare(
+	"SELECT islands.islandid AS islandid, archipelago, islandname,
+			sum(qty) as tqty
+		FROM islands $joinkind $bs offers
+		ON islands.islandid == offers.islandid AND commodid == ?
+		GROUP BY islands.islandid
+		ORDER BY archipelago, islandname"
+		);
+
+	my $offers= $dbh->prepare(
+	"SELECT stallname, price, qty
+		FROM $bs NATURAL JOIN stalls
+		WHERE commodid = ? AND islandid = ?
+		ORDER BY price $ascdesc"
+		);
+
+
+
+
Offers to <% uc $bs |h %> <% $commodname |h %>

+%	$islands->execute($cmid);
+%	my $island;
+%	my %ts_sortkeys;
+%	my $rowix= 0;
+%	while ($island= $islands->fetchrow_hashref) {
+%		if (!$rowix) {
+
+
+
+
+%		}
+%		my $islandid= $island->{'islandid'};
+%		$offers->execute($cmid, $islandid);
+%		my ($offer, $bestprice, $marginal, @beststalls);
+%		my $tqty= $island->{'tqty'};
+%		my $cqty= '';
+%		my $bestqty= '';
+%		my $approxqty= '';
+%		my $median= '-';
+%		while ($offer= $offers->fetchrow_hashref) {
+%			my $price= $offer->{'price'};
+%			my $qty= $offer->{'qty'};
+%			length $bestqty or $bestprice= $price;
+%			if ($price == $bestprice) {
+%				$bestqty += $qty;
+%				push @beststalls, $offer->{'stallname'};
+%			}
+%			$cqty += $qty;
+%			if ($cqty*2 >= $tqty && $median eq '-') {
+%				$median= $price;
+%			}
+%			if ($bestprice*9 <= $price*10 and
+%			    $price*10 <= $bestprice*11) {
+%				$approxqty += $qty;
+%			}
+%		}
+%		my $stallname;
+%
+%		my $rowid= "id_${bs}_$islandid";
+%		my $s= [ ];
+%
+%		$s->[2]= sprintf "%06d", scalar @beststalls;
+%		if (!@beststalls) {
+%			$stallname= '-';
+%		} elsif (@beststalls==1) {
+%			$stallname= $beststalls[0];
+%			$s->[2] .= " $stallname";
+%		} else {
+%			$stallname= sprintf "%d offers", scalar @beststalls;
+%		}
+%
+%		$cqty == $tqty or die "$bs $cqty $tqty $cmid $islandid ";
+ class="<% 'datarow'.($rowix & 1) %>">
+     
+%		for my $cix (0..$#$s) {
+%			$ts_sortkeys{$cix}{$rowid}= $s->[$cix];
+%		}
+%		$rowix++;
+%	}
+%	if ($rowix) {
+

+Prices
+Quantity at price
+
Archipelago
+Island
+Stall(s)
+Best
+Median
+Best
++/-10%
+Any
+
<% $s->[0]= $island->{'archipelago'} |h %>
+     <% $s->[1]= $island->{'islandname'} |h %>
+     <%          $stallname |h %>
+     <% $s->[3]= (length $bestqty ? $bestprice : '-') %>
+     <% $s->[4]= $median %>
+     <% $s->[5]= $bestqty %>
+     <% $s->[6]= $approxqty %>
+     <% $s->[7]= $cqty %>
+

+
+<&| tabsort,	table => "${bs}_table", sortkeys => "${bs}_sortkeys",
+		throw => "${bs}_table_thr", rowclass => 'datarow', cols => [
+	{}, {},
+	{ DoReverse => 1 },
+	{ DoReverse => 1, Numeric => 1, MapFn => "ts_Pricemap_${bs}" },
+	{ DoReverse => 1, Numeric => 1, MapFn => "ts_Pricemap_${bs}" },
+	{ DoReverse => 1, Numeric => 1 },
+	{ DoReverse => 1, Numeric => 1 },
+	{ DoReverse => 1, Numeric => 1 },
+	] &>
+  <% $bs %>_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>;
+  function ts_Pricemap_<% $bs %>(price) {
+    if (price=='-') { return <% $bs eq 'buy' ? '-1' : '99999999' %>; }
+    return price;
+  }
+
+%	} else {
+No offers.
+%	}
+
+<%perl>
+}
+
diff --git a/yarrg/web/query_route b/yarrg/web/query_route
new file mode 100644
index 0000000..393e7a6
--- /dev/null
+++ b/yarrg/web/query_route
@@ -0,0 +1,231 @@
+<%doc>
+
+ This is part of the YARRG website.  YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson 
+ Copyright (C) 2009 Clare Boothby
+
+  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+  The YARRG website is covered by the GNU Affero GPL v3 or later, which
+   basically means that every installation of the website will let you
+   download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program.  If not, see .
+
+ Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+ are used without permission.  This program is not endorsed or
+ sponsored by Three Rings.
+
+
+ This Mason component generates the core of the `trade route' query.
+
+
+
+<%args>
+$quri
+$dbh
+$prselector
+$routestring => '';
+$someresults
+$emsgokorprint
+
+
+<%perl>
+my $emsg;
+my @archipelagoes;
+my @islandids;
+my %islandid2;
+
+my $qa= \%ARGS;
+
+my $be_post;
+my $startform= sub {
+	($be_post)= @_;
+
+

+<%perl>
+};
+my $goupdate= sub { $be_post ? 'Update' : 'Go' };
+
+
+
+
Specify route

+
+% $prselector->('ShowStalls');
+
+%#---------- textbox, user enters route as string ----------
+% if (!$qa->{Dropdowns}) {
+
+Enter route (islands, or archipelagoes, separated by |s or commas;
+ abbreviations are OK):

+
+% $startform->($routestring =~ m/\S/);
+
+<&| qtextstring, qa => $qa, dbh => $dbh,
+    thingstring => 'routestring', emsgstore => \$emsg,
+    perresult => sub {
+	my ($canonname, $island, $arch) = @_;
+	push @islandids, $island;
+	push @archipelagoes, defined $island ? undef : $arch;
+    }
+ &>
+ size=80
+
+
+% } else { #---------- dropdowns, user selects from menus ----------
+
+% $startform->(grep {
+%		defined $ARGS{"archipelago$_"} ||
+%		defined $ARGS{"islandid$_"}
+%	} (0..$qa->{Dropdowns}-1));
+
+<%perl>
+my ($sth,$row);
+my @archlistdata;
+my %islandlistdata;
+$islandlistdata{'none'}= [ [ "none", "Select island..." ] ];
+
+my $optionlistmap= sub {
+	my ($optlist, $selected) = @_;
+	my $out='';
+	foreach my $entry (@$optlist) {
+		$out.= sprintf('',
+			encode_entities($entry->[0]),
+			defined $selected && $entry->[0] eq $selected
+				? 'selected' : '',
+			encode_entities($entry->[1]));
+	}
+	return $out;
+};
+
+$sth= $dbh->prepare("SELECT DISTINCT archipelago FROM islands
+			    ORDER BY archipelago;");
+$sth->execute();
+
+while ($row=$sth->fetchrow_arrayref) {
+	my ($arch)= @$row;
+	push @archlistdata, [ $arch, $arch ];
+	$islandlistdata{$arch}= [ [ "none", "Whole arch" ] ];
+}
+
+$sth= $dbh->prepare("SELECT islandid,islandname,archipelago
+                            FROM islands
+			    ORDER BY islandname;");
+$sth->execute();
+
+while ($row=$sth->fetchrow_arrayref) {
+	my $arch= $row->[2];
+	push @{ $islandlistdata{'none'} }, [ @$row ];
+	push @{ $islandlistdata{$arch} }, [ @$row ];
+	$islandid2{$row->[0]}= { Name => $row->[1], Arch => $arch };
+}
+
+my %resetislandlistdata;
+foreach my $arch (keys %islandlistdata) {
+	$resetislandlistdata{$arch}=
+		$optionlistmap->($islandlistdata{$arch}, '');
+}
+
+
+
+<&| script &>
+ms_lists= <% to_json_protecttags(\%resetislandlistdata) %>;
+function ms_Setarch(dd) {
+  debug('ms_SetArch '+dd+' arch='+arch);
+  var arch= document.getElementsByName('archipelago'+dd).item(0).value;
+  var got= ms_lists[arch];
+  if (got == undefined) return; // unknown arch ?  hrm
+  debug('ms_SetArch '+dd+' arch='+arch+' got ok');
+  var select= document.getElementsByName('islandid'+dd).item(0);
+  select.innerHTML= got;
+  debug('ms_SetArch '+dd+' arch='+arch+' innerHTML set');
+}
+
+
+
+
+
+%	for my $dd (0..$qa->{Dropdowns}-1) {
+
+%	}
+
+
+
+%	for my $dd (0..$qa->{Dropdowns}-1) {
+%		my $arch= $ARGS{"archipelago$dd"};
+%		$arch= 'none' if !defined $arch;
+
+%	}
+
+
+

+

+

+
+% } #---------- end of dropdowns, now common middle of page code ----------
+
+
+% my $ours= sub { $_[0] =~ m/^island|^archipelago|^routestring|^[RT]/; };
+<& "lookup:formhidden", ours => $ours &>
+
+<%perl>
+#========== results ==========
+
+$emsgokorprint->($emsg) or @islandids=();
+
+my $argorundef= sub {
+	my ($dd,$base) = @_;
+	my $thing= $ARGS{"${base}${dd}"};
+	$thing= undef if defined $thing and $thing eq 'none';
+	return $thing;
+};
+
+for my $dd (0..$qa->{Dropdowns}-1) {
+	my $arch= $argorundef->($dd,'archipelago');
+	my $island= $argorundef->($dd,'islandid');
+	next unless defined $arch or defined $island;
+	if (defined $island and defined $arch) {
+		my $ii= $islandid2{$island};
+		my $iarch= $ii->{Arch};
+		if ($iarch ne $arch) {
+			$someresults->();
+
+ Specified archipelago <% $arch %> but
+ island <% $ii->{Name} %>
+ which is in <% $iarch %>; using the island.

+<%perl>
+		}
+		$arch= undef;
+	}
+	push @archipelagoes, $arch;
+	push @islandids, $island;
+}
+
+
+
+% if (@islandids) {
+%	$someresults->('Relevant trades');
+<& routetrade,
+   dbh => $dbh,
+   islandids => \@islandids,
+   archipelagoes => \@archipelagoes,
+   qa => $qa
+ &>
+

+% }
diff --git a/yarrg/web/routetrade b/yarrg/web/routetrade
new file mode 100644
index 0000000..4885782
--- /dev/null
+++ b/yarrg/web/routetrade
@@ -0,0 +1,714 @@
+<%doc>
+
+ This is part of the YARRG website.  YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson 
+ Copyright (C) 2009 Clare Boothby
+
+  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+  The YARRG website is covered by the GNU Affero GPL v3 or later, which
+   basically means that every installation of the website will let you
+   download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program.  If not, see .
+
+ Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+ are used without permission.  This program is not endorsed or
+ sponsored by Three Rings.
+
+
+ This Mason component is the core trade planner for a specific route.
+
+
+
+<%args>
+$dbh
+@islandids
+@archipelagoes
+$qa
+
+<&| script &>
+  da_pageload= Date.now();
+
+
+<%perl>
+
+my $now= time;
+my $loss_per_league= 1e-7;
+
+my @flow_conds;
+my @query_params;
+my %dists;
+
+my $sd_condition= sub {
+	my ($bs, $ix) = @_;
+	my $islandid= $islandids[$ix];
+	if (defined $islandid) {
+		return "${bs}.islandid = $islandid";
+	} else {
+		push @query_params, $archipelagoes[$ix];
+		return "${bs}_islands.archipelago = ?";
+	}
+};
+
+my %islandpair;
+# $islandpair{$a,$b}= [ $start_island_ix, $end_island_ix ]
+
+my $specific= !grep { !defined $_ } @islandids;
+my $confusing= 0;
+
+foreach my $src_i (0..$#islandids) {
+	my $src_isle= $islandids[$src_i];
+	my $src_cond= $sd_condition->('sell',$src_i);
+	my @dst_conds;
+	foreach my $dst_i ($src_i..$#islandids) {
+		my $dst_isle= $islandids[$dst_i];
+		my $dst_cond= $sd_condition->('buy',$dst_i);
+		if ($dst_i==$src_i and !defined $src_isle) {
+			# we always want arbitrage, but mentioning an arch
+			# once shouldn't produce intra-arch trades
+			$dst_cond=
+				"($dst_cond AND sell.islandid = buy.islandid)";
+		}
+		push @dst_conds, $dst_cond;
+
+		if ($specific && !$confusing &&
+		    # With a circular route, do not carry goods round the loop
+		    !(($src_i==0 || $src_i==$#islandids) &&
+		      $dst_i==$#islandids &&
+		      $src_isle == $islandids[$dst_i])) {
+			if ($islandpair{$src_isle,$dst_isle}) {
+				$confusing= 1;
+print "confusing $src_i $src_isle  $dst_i $dst_isle\n";
+			} else {
+				$islandpair{$src_isle,$dst_isle}=
+					[ $src_i, $dst_i ];
+			}
+		}
+	}
+	push @flow_conds, "$src_cond AND (
+			".join("
+		     OR ",@dst_conds)."
+		)";
+}
+
+my $stmt= "		
+	SELECT  sell_islands.islandname				org_name,
+		sell_islands.islandid				org_id,
+		sell.price					org_price,
+		sell.qty 					org_qty_stall,
+		sell_stalls.stallname				org_stallname,
+		sell.stallid					org_stallid,
+		sell_uploads.timestamp				org_timestamp,
+		buy_islands.islandname				dst_name,
+		buy_islands.islandid				dst_id,
+		buy.price					dst_price,
+		buy.qty 					dst_qty_stall,
+		buy_stalls.stallname				dst_stallname,
+		buy.stallid					dst_stallid,
+		buy_uploads.timestamp				dst_timestamp,
+".($qa->{ShowStalls} ? "
+		sell.qty 					org_qty_agg,
+		buy.qty 					dst_qty_agg,
+" : "
+		(SELECT sum(qty) FROM sell AS sell_agg
+		  WHERE	sell_agg.commodid = commods.commodid
+		  AND	sell_agg.islandid = sell.islandid
+		  AND	sell_agg.price = sell.price)		org_qty_agg,
+		(SELECT sum(qty) FROM buy AS buy_agg
+		  WHERE	buy_agg.commodid = commods.commodid
+		  AND	buy_agg.islandid = buy.islandid
+		  AND	buy_agg.price = buy.price)		dst_qty_agg,
+")."
+		commods.commodname				commodname,
+		commods.commodid				commodid,
+		commods.unitmass				unitmass,
+		commods.unitvolume				unitvolume,
+		dist						dist,
+		buy.price - sell.price				unitprofit
+	FROM commods
+	JOIN sell ON commods.commodid = sell.commodid
+	JOIN buy  ON commods.commodid = buy.commodid
+	JOIN islands AS sell_islands ON sell.islandid = sell_islands.islandid
+	JOIN islands AS buy_islands  ON buy.islandid  = buy_islands.islandid
+	JOIN uploads AS sell_uploads ON sell.islandid = sell_uploads.islandid
+	JOIN uploads AS buy_uploads  ON buy.islandid  = buy_uploads.islandid
+	JOIN stalls  AS sell_stalls  ON sell.stallid  = sell_stalls.stallid
+	JOIN stalls  AS buy_stalls   ON buy.stallid   = buy_stalls.stallid
+	JOIN dists ON aiid = sell.islandid AND biid = buy.islandid
+	WHERE	(
+		".join("
+	   OR	", @flow_conds)."
+	)
+	  AND	buy.price > sell.price
+	ORDER BY org_name, dst_name, commodname, unitprofit DESC,
+		 org_price, dst_price DESC,
+		 org_stallname, dst_stallname
+     ";
+
+my $sth= $dbh->prepare($stmt);
+$sth->execute(@query_params);
+my @flows;
+
+my $distquery= $dbh->prepare("
+		SELECT dist FROM dists WHERE aiid = ? AND biid = ?
+		");
+my $distance= sub {
+	my ($from,$to)= @_;
+	my $d= $dists{$from}{$to};
+	return $d if defined $d;
+	$distquery->execute($from,$to);
+	$d = $distquery->fetchrow_array();
+	defined $d or die "$from $to ?";
+	$dists{$from}{$to}= $d;
+	return $d;
+};
+
+my @cols= ({ NoSort => 1 });
+
+my $addcols= sub {
+	my $base= shift @_;
+	foreach my $name (@_) {
+		my $col= { Name => $name, %$base };
+		$col->{Numeric}=1 if !$col->{Text};
+		push @cols, $col;
+	}
+};
+
+if ($qa->{ShowStalls}) {
+	$addcols->({ Text => 1 }, qw(
+		org_name org_stallname
+		dst_name dst_stallname
+	));
+} else {
+	$addcols->({Text => 1 }, qw(
+		org_name dst_name
+	));
+}
+$addcols->({ Text => 1 }, qw(commodname));
+$addcols->({ DoReverse => 1 },
+	qw(	org_price org_qty_agg dst_price dst_qty_agg
+	));
+$addcols->({ DoReverse => 1, SortColKey => 'MarginSortKey' },
+	qw(	Margin
+	));
+$addcols->({ DoReverse => 1 },
+	qw(	unitprofit dist MaxQty
+		MaxCapital MaxProfit
+	));
+
+
+
+% if ($qa->{'debug'}) {
+
+<% $stmt |h %>
+<% join(' | ',@query_params) |h %>
+

+% }
+
+<& dumptable:start, qa => $qa, sth => $sth &>
+% {
+%   my $got;
+%   while ($got= $sth->fetchrow_hashref()) {
+<%perl>
+
+	my $f= $flows[$#flows];
+	if (	!$f ||
+		$qa->{ShowStalls} ||
+		grep { $f->{$_} ne $got->{$_} }
+			qw(org_id org_price dst_id dst_price commodid)
+	) {
+		# Make a new flow rather than adding to the existing one
+
+		$f= {
+			Ix => scalar(@flows),
+			Var => "f".@flows,
+			%$got
+		};
+		$f->{"org_stallid"}= $f->{"dst_stallid"}= 'all'
+			if !$qa->{ShowStalls};
+		push @flows, $f;
+	}
+	foreach my $od (qw(org dst)) {
+		$f->{"${od}Stalls"}{
+			$got->{"${od}_stallname"}
+		    } =
+			$got->{"${od}_qty_stall"}
+		    ;
+	}
+
+
+<& dumptable:row, qa => $qa, sth => $sth, row => $f &>
+%    }
+<& dumptable:end, qa => $qa &>
+% }
+
+<%perl>
+
+if (!@flows) {
+	print 'No profitable trading opportunities were found.';
+	return;
+}
+
+foreach my $f (@flows) {
+
+	$f->{MaxQty}= $f->{'org_qty_agg'} < $f->{'dst_qty_agg'}
+		? $f->{'org_qty_agg'} : $f->{'dst_qty_agg'};
+	$f->{MaxProfit}= $f->{MaxQty} * $f->{'unitprofit'};
+	$f->{MaxCapital}= $f->{MaxQty} * $f->{'org_price'};
+
+	$f->{MarginSortKey}= sprintf "%d",
+		$f->{'dst_price'} * 10000 / $f->{'org_price'};
+	$f->{Margin}= sprintf "%3.1f%%",
+		$f->{'dst_price'} * 100.0 / $f->{'org_price'} - 100.0;
+
+	$f->{ExpectedUnitProfit}=
+		$f->{'dst_price'} * (1.0 - $loss_per_league) ** $f->{'dist'}
+		- $f->{'org_price'};
+
+	$dists{'org_id'}{'dst_id'}= $f->{'dist'};
+
+	my @uid= $f->{commodid};
+	foreach my $od (qw(org dst)) {
+		push @uid,
+			$f->{"${od}_id"},
+			$f->{"${od}_price"};
+		push @uid,
+			$f->{"${od}_stallid"}
+				if $qa->{ShowStalls};
+	}
+	$f->{UidLong}= join '_', @uid;
+
+	my $base= 31;
+	my $cmpu= '';
+	map {
+		my $uue= $_;
+		my $first= $base;
+		do {
+			my $this= $uue % $base;
+print STDERR "uue=$uue this=$this ";
+			$uue -= $this;
+			$uue /= $base;
+			$this += $first;
+			$first= 0;
+			$cmpu .= chr($this + ($this < 26 ? ord('a') :
+					      $this < 52 ? ord('A')-26
+							 : ord('0')-52));
+print STDERR " uue=$uue this=$this cmpu=$cmpu\n";
+die "$cmpu $uue ?" if length $cmpu > 20;
+		} while ($uue);
+		$cmpu;
+	} @uid;
+	$f->{UidShort}= $cmpu;
+
+	if ($qa->{'debug'}) {
+		my @outuid;
+		$_= $f->{UidShort};
+		my $mul;
+		while (m/./) {
+			my $v= m/^[a-z]/ ? ord($&)-ord('a') :
+			       m/^[A-Z]/ ? ord($&)-ord('A')+26 :
+			       m/^[0-9]/ ? ord($&)-ord('0')+52 :
+			       die "$_ ?";
+			if ($v >= $base) {
+				push @outuid, 0;
+				$v -= $base;
+				$mul= 1;
+#print STDERR "(next)\n";
+			}
+			die "$f->{UidShort} $_ ?" unless defined $mul;
+			$outuid[$#outuid] += $v * $mul;
+
+#print STDERR "$f->{UidShort}  $_  $&  v=$v  mul=$mul  ord()=".ord($&).
+#			"[vs.".ord('a').",".ord('A').",".ord('0')."]".
+#			"  outuid=@outuid\n";
+
+			$mul *= $base;
+			s/^.//;
+		}
+		my $recons_long= join '_', @outuid;
+		$f->{UidLong} eq $recons_long or
+			die "$f->{UidLong} = $f->{UidShort} = $recons_long ?";
+	}
+
+	if (defined $qa->{"R$f->{UidShort}"} &&
+	    !defined $qa->{"T$f->{UidShort}"}) {
+		$f->{Suppress}= 1;
+	}
+
+}
+
+
+% my $optimise= $specific && !$confusing && @islandids>1;
+% if (!$optimise) {
+
+

+% if (@islandids<=1) {
+Route is trivial.
+% }
+% if (!$specific) {
+Route contains archipelago(es), not just specific islands.
+% }
+% if ($confusing) {
+Route is complex - it visits the same island several times
+and isn't a simple loop.
+% }
+Therefore, optimal voyage trade plan not calculated.
+
+% } else { # ========== OPTMISATION ==========
+<%perl>
+
+my $cplex= "
+Maximize
+
+  totalprofit:
+                  ".(join " +
+                  ", map {
+			sprintf "%.20f %s", $_->{ExpectedUnitProfit}, $_->{Var}
+			} @flows)."
+
+Subject To
+";
+
+my %avail_csts;
+foreach my $flow (@flows) {
+	if ($flow->{Suppress}) {
+		$cplex .= "
+   $flow->{Var} = 0
+";
+		next;
+	}
+	foreach my $od (qw(org dst)) {
+		my $cstname= join '_', (
+			'avail',
+			$flow->{'commodid'},
+			$od,
+			$flow->{"${od}_id"},
+			$flow->{"${od}_price"},
+			$flow->{"${od}_stallid"},
+		);
+			
+		push @{ $avail_csts{$cstname}{Flows} }, $flow->{Var};
+		$avail_csts{$cstname}{Qty}= $flow->{"${od}_qty_agg"};
+	}
+}
+foreach my $cstname (sort keys %avail_csts) {
+	my $c= $avail_csts{$cstname};
+	$cplex .= "
+   ".	sprintf("%-30s","$cstname:")." ".
+	join("+", @{ $c->{Flows} }).
+	" <= ".$c->{Qty}."\n";
+}
+
+$cplex.= "
+Bounds
+        ".(join "
+        ", map { "$_->{Var} >= 0" } @flows)."
+
+End
+";
+
+if ($qa->{'debug'}) {
+
+
+<% $cplex |h %>
+

+<%perl>
+}
+
+{
+	my $input= pipethrough_prep();
+	print $input $cplex or die $!;
+	my $output= pipethrough_run_along($input, undef, 'glpsol',
+		qw(glpsol --cpxlp /dev/stdin -o /dev/stdout));
+	print "
\n" if $qa->{'debug'};
+	my $found_section= 0;
+	my $glpsol_out= '';
+	while (<$output>) {
+		$glpsol_out.= $_;
+		print encode_entities($_) if $qa->{'debug'};
+		if (m/^\s*No\.\s+Column name\s+St\s+Activity\s/) {
+			die if $found_section>0;
+			$found_section= 1;
+			next;
+		}
+		next unless $found_section==1;
+		next if m/^[- ]+$/;
+		if (!/\S/) {
+			$found_section= 2;
+			next;
+		}
+		my ($ix, $qty) =
+			m/^\s*\d+\s+f(\d+)\s+\S+\s+(\d+)\s/ or die "$_ ?";
+		my $flow= $flows[$ix] or die;
+		$flow->{OptQty}= $qty;
+		$flow->{OptProfit}= $flow->{'unitprofit'} * $qty;
+		$flow->{OptCapital}= $flow->{OptQty} * $flow->{'org_price'};
+	}
+	print "
\n" if $qa->{'debug'};
+	my $prerr= "\n=====\n$cplex\n=====\n$glpsol_out\n=====\n ";
+	pipethrough_run_finish($output,$prerr);
+	die $prerr unless $found_section;
+};
+
+$addcols->({ DoReverse => 1 }, qw(
+		OptQty
+	));
+$addcols->({ Total => 0, DoReverse => 1 }, qw(
+		OptCapital OptProfit
+	));
+
+
+
+% } # ========== OPTIMISATION ==========
+
+% my %ts_sortkeys;
+% {
+%	my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : '';
+%	my $cdstall= $qa->{ShowStalls} ? 'Stall' : '';
+
+++<% $qa->{ShowStalls} ? '' : '' %>
+++++++%	if ($optimise) {
++%	}
+
+
+
+% foreach my $col (@cols) {
+
+
+











+>Collect
+>Deliver
+
+Collect
+Deliver
+Profit
+
+Max
+%	if ($optimise) {
+Planned
+%	}
+
+

+Island <% $cdstall %>
+Island <% $cdstall %>
+Commodity
+Price
+Qty
+Price
+Qty
+Margin
+Unit
+Dist
+Qty
+Capital
+Profit
+%	if ($optimise) {
+Qty
+Capital
+Profit
+%	}
+% }
+
+

+% }
+
+% foreach my $flowix (0..$#flows) {
+%	my $flow= $flows[$flowix];
+%	my $rowid= "id_row_$flow->{UidShort}";
+
{UidShort} %> value="">
+    {UidShort} %> value=""
+       <% $flow->{Suppress} ? '' : 'checked' %> >
+%	foreach my $ci (1..$#cols) {
+%		my $col= $cols[$ci];
+%		my $v= $flow->{$col->{Name}};
+%		$col->{Total} += $v if defined $col->{Total};
+%		$v='' if !$col->{Text} && !$v;
+%		my $sortkey= $col->{SortColKey} ?
+%			$flow->{$col->{SortColKey}} : $v;
+%		$ts_sortkeys{$ci}{$rowid}= $sortkey;
+{Text} ? '' : 'align=right' %>><% $v |h %>
+%	}
+% }
+

+Total
+% foreach my $ci (3..$#cols) {
+%	my $col= $cols[$ci];
+
+%	if (defined $col->{Total}) {
+<% $col->{Total} |h %>
+%	}
+% }
+

+
+<&| tabsort, cols => \@cols, table => 'trades', rowclass => 'datarow',
+	throw => 'trades_sort', tbrow => 'trades_total' &>
+  ts_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>;
+
+
+
+
+% if ($optimise) { # ========== TRADING PLAN ==========
+%
+% my $iquery= $dbh->prepare('SELECT islandname FROM islands
+%				WHERE islandid = ?');
+% my %da_ages;
+% my $total_total= 0;
+% my $total_dist= 0;
+%
+
Voyage trading plan

+
+% foreach my $i (0..$#islandids) {
+
+
+%	}
+<%perl>
+     my $age_reported= 0;
+     my %flowlists;
+     foreach my $od (qw(org dst)) {
+	foreach my $f (@flows) {
+		next if $f->{Suppress};
+		next unless $f->{"${od}_id"} == $islandids[$i];
+		next unless $f->{OptQty};
+		my $arbitrage= $f->{'org_id'} == $f->{'dst_id'};
+		my $loop= $islandids[0] == $islandids[-1] &&
+			  ($i==0 || $i==$#islandids);
+		next if $loop and ($arbitrage ? $i :
+			!!$i == !!($od eq 'org'));
+		my $price= $f->{"${od}_price"};
+		my $stallname= $f->{"${od}_stallname"};
+		my $todo= \$flowlists{$od}{
+				$f->{'commodname'},
+				(sprintf "%07d", ($od eq 'dst' ?
+						9999999-$price : $price)),
+				$stallname
+			};
+		$$todo= {
+			Qty => 0,
+			orgArbitrage => 0,
+			dstArbitrage => 0,
+		} unless $$todo;
+		$$todo->{'commodname'}= $f->{'commodname'};
+		$$todo->{'stallname'}= $stallname;
+		$$todo->{Price}= $price;
+		$$todo->{Timestamp}= $f->{"${od}_timestamp"};
+		$$todo->{Qty} += $f->{OptQty};
+		$$todo->{Total}= $$todo->{Price} * $$todo->{Qty};
+		$$todo->{Stalls}= $f->{"${od}Stalls"};
+		$$todo->{"${od}Arbitrage"}= 1 if $arbitrage;
+	}
+     }
+
+     my $total;
+     my $dline= 0;
+     my $show_flows= sub {
+	my ($od,$arbitrage,$collectdeliver) = @_;
+
+%
+%	my $todo= $flowlists{$od};
+%	return unless $todo;
+%	foreach my $tkey (sort keys %$todo) {
+%		my $t= $todo->{$tkey};
+%		next if $t->{"${od}Arbitrage"} != $arbitrage;
+%		if (!$age_reported++) {
+%			my $age= $now - $t->{Timestamp};
+%			my $cellid= "da_${i}";
+%			$da_ages{$cellid}= $age;
+
+%		}
+%		$total += $t->{Total};
+%		my $span= 0 + keys %{ $t->{Stalls} };
+%		my $td= "td rowspan=$span";
+
+<<% $td %>><% $collectdeliver %>
+<<% $td %>><% $t->{'commodname'} |h %>
+%
+%		my @stalls= sort keys %{ $t->{Stalls} };
+%		my $pstall= sub {
+%			my $name= $stalls[$_[0]];
+
+%			$pstall->($stallix);
+%		}
+%
+%		$dline ^= 1;
+%	}
+%    };
+%    my $show_total= sub {
+%	my ($totaldesc, $sign)= @_;
+%	if (defined $total) {
+
+
+

+%	$iquery->execute($islandids[$i]);
+%	my ($islandname) = $iquery->fetchrow_array();
+%	my $this_dist= $distance->($islandids[$i-1],$islandids[$i]);
+%	$total_dist += $this_dist;
+%	if (!$i) {
+Start at <% $islandname |h %>
+%	} else {
+Sail to <% $islandname |h %>
+- <% $this_dist |h %> leagues \
+(Data age: <% prettyprint_age($age) %>)
+%		} elsif (!defined $total) {
+%			$total= 0;
+
<% $name |h %>
+%		};
+%
+%		$pstall->(0);
+<<% $td %> align=right><% $t->{Price} |h %> poe ea.
+<<% $td %> align=right><% $t->{Qty} |h %> unit(s)
+<<% $td %> align=right><% $t->{Total} |h %> total
+%
+%		foreach my $stallix (1..$#stalls) {
+

+<% $totaldesc %>
+<% $total |h %> total
+%		$total_total += $sign * $total;
+%	}
+%	$total= undef;
+%	$dline= 0;
+<%perl>
+     };
+
+     $show_flows->('dst',0,'Deliver'); $show_total->('Proceeds',1);
+     $show_flows->('org',1,'Collect'); $show_total->('(Arbitrage) outlay',-1);
+     $show_flows->('dst',1,'Deliver'); $show_total->('(Arbitrage) proceeds',1);
+     $show_flows->('org',0,'Collect'); $show_total->('Outlay',-1);
+
+}
+
+
Total distance: <% $total_dist %> leagues.
+Overall net cash flow
+<%
+  $total_total < 0 ? -$total_total." loss" : $total_total." gain"
+ %>
+

+<& query_age:dataages, id2age => \%da_ages &>
+%
+% } # ========== TRADING PLAN ==========
+
+<%init>
+use CommodsWeb;
+use Commods;
+
diff --git a/yarrg/web/script b/yarrg/web/script
new file mode 100644
index 0000000..b8e7d03
--- /dev/null
+++ b/yarrg/web/script
@@ -0,0 +1,49 @@
+<%doc>
+
+ This is part of the YARRG website.  YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson 
+ Copyright (C) 2009 Clare Boothby
+
+  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+  The YARRG website is covered by the GNU Affero GPL v3 or later, which
+   basically means that every installation of the website will let you
+   download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program.  If not, see .
+
+ Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+ are used without permission.  This program is not endorsed or
+ sponsored by Three Rings.
+
+
+ This Mason component wraps Javascript which is to be embedded in HTML
+ pages to deal with some of the bizarre quoting problems and behaviours
+ in Javascript 
+<%init>
+my $ct= $m->content;
+
+die "bad script content $&"
+    if $ct =~ m,\<\/|--\>,;
+
diff --git a/yarrg/web/source.tar.gz b/yarrg/web/source.tar.gz
new file mode 100755
index 0000000..1d92ad8
--- /dev/null
+++ b/yarrg/web/source.tar.gz
@@ -0,0 +1,76 @@
+<%doc>
+
+ This is part of the YARRG website.  YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson 
+ Copyright (C) 2009 Clare Boothby
+
+  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+  The YARRG website is covered by the GNU Affero GPL v3 or later, which
+   basically means that every installation of the website will let you
+   download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program.  If not, see .
+
+ Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+ are used without permission.  This program is not endorsed or
+ sponsored by Three Rings.
+
+
+ This Mason component allows visitors to the YARRG website to download
+ the YARRG website's source code.
+
+
+<%flags>
+inherit => undef
+<%perl>
+use IO::Pipe;
+use CommodsWeb;
+
+$r->content_type('application/octet-stream');
+$m->flush_buffer();
+
+$ENV{'YPPSC_YARRG_SRCBASE'}= sourcebasedir();
+my $pipe= new IO::Pipe or die $!;
+my $pid= fork();  defined $pid or die $!;
+if (!$pid) {
+	$pipe->writer();
+	exec '/bin/sh','-c','
+		cd -P "$YPPSC_YARRG_SRCBASE"
+		(
+		 git-ls-files -z;
+		 git-ls-files -z --others --exclude-from=.gitignore;
+		 if test -d .git; then find .git -print0; fi
+		) | (
+		 cpio -Hustar -o --quiet -0 -R 1000:1000 || \
+		 cpio -Hustar -o --quiet -0
+		) | gzip
+	';
+	die $!;
+}
+$pipe->reader();
+
+my ($d, $l);
+while ($l= read $pipe, $d, 65536) {
+	print $d;
+	$m->flush_buffer();
+}
+waitpid $pid,0;
+defined $l or die "read pipe $!";
+$pipe->error and die "pipe error $!";
+close $pipe;
+# deliberately ignore errors
+
+
diff --git a/yarrg/web/tabsort b/yarrg/web/tabsort
new file mode 100644
index 0000000..e114319
--- /dev/null
+++ b/yarrg/web/tabsort
@@ -0,0 +1,175 @@
+<%doc>
+
+ This is part of the YARRG website.  YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson 
+ Copyright (C) 2009 Clare Boothby
+
+  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+  The YARRG website is covered by the GNU Affero GPL v3 or later, which
+   basically means that every installation of the website will let you
+   download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program.  If not, see .
+
+ Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+ are used without permission.  This program is not endorsed or
+ sponsored by Three Rings.
+
+
+ This Mason component generates Javascript for sorting tables in
+ DHTML.
+
+
+
+
+<%args>
+$table => 'ts_table'
+$sortkeys => 'ts_sortkeys'
+$throw => undef
+$tbrow => undef
+$rowclass => undef
+$cols
+
+
+<%doc>
+	Numeric
+	SortKey
+	MapFn
+	NoSort
+	DoReverse
+
+
+<&| script &>
+
+% print $m->content();
+
+%	my $sortfn= "ts_sort__$table";
+function <% $sortfn %>(compar) {
+  debug('sorting compar='+compar);
+  var table= document.getElementById('<% $table %>');
+  var firstrow= table.getElementsByTagName('tr').item(0);
+  var tbody= firstrow.parentNode
+  var rows= tbody.childNodes
+  var newrows= new Array;
+  var finalrows= new Array;
+  var rowix= 0;
+%	if (defined $throw) {
+  for (; rowix < rows.length; rowix++) {
+    var row= rows.item(rowix);
+    if (row.id == '<% $throw %>') break;
+    debug('skip row '+rowix+' [[ '+row+' ]] id='+row.id);
+  }
+  rowix++;
+%	}
+  for (; rowix < rows.length; rowix++) {
+    var row= rows.item(rowix);
+%	if (defined $tbrow) {
+    if (row.id == '<% $tbrow %>') break;
+%	}
+    if (!row.id) { debug('noid row '+rowix+' [[ '+row+' ]]'); continue; }
+    if (row.tagName != 'TR') {
+      debug('no-tr row '+rowix+' tagName='+row.tagName+' [[ '+row+' ]]');
+      continue;
+    }
+    debug('process row '+rowix+' [[ '+row+' ]] id='+row.id);
+    newrows.push(row);
+  }
+  for (; rowix < rows.length; rowix++) {
+    var row= rows.item(rowix);
+    finalrows.push(row);
+    debug('final row '+rowix+' [[ '+row+' ]]');
+  }
+  newrows.sort(compar);
+%	if (defined $rowclass) {
+  for (var rowix=0; rowix < newrows.length; rowix++) {
+    var row= newrows[rowix];
+    var classname= '<% $rowclass %>'+(rowix % 2);
+    debug('fix row '+rowix+' class '+classname);
+    row.className= classname;
+  }
+%	}
+  newrows= newrows.concat(finalrows);
+  for (var rowix=0; rowix < newrows.length; rowix++) {
+    var row= newrows[rowix];
+    debug('add row '+rowix+' [[ '+row+' ]]');
+    tbody.appendChild(row);
+  }
+}
+
+% my %add_heads;
+% foreach my $cix (0..$#$cols) {
+%	my $col= $cols->[$cix];
+%	my $thhtml= '';
+%	next if $col->{NoSort};
+
+%	my $mapfn= "ts_compar${cix}_map__$table";
+function <% $mapfn %>(rowelement) {
+  var rowid = rowelement.id;
+%	if ($col->{SortKey}) {
+  return <% $col->{SortKey} %>;
+%	} else {
+%		my $sk= "$sortkeys"."[$cix][rowid]";
+%		if ($col->{MapFn}) {
+  return <% $col->{MapFn} %>(<% $sk %>);
+%		} else {
+  return <% $sk %>;
+%		}
+%	}
+}
+
+%	my $comparefn= "ts_compar${cix}_cmp0__$table";
+function <% $comparefn %>(a,b) {
+  var a_key = <% $mapfn %>(a);
+  var b_key = <% $mapfn %>(b);
+%	if ($col->{Numeric}) {
+  return a_key - b_key
+%	} else {
+  if (a_key < b_key) return -1;
+  if (a_key > b_key) return +1;
+  return 0;
+%	}
+}
+
+%	foreach my $reverse (qw(1 0)) {
+%		my $tcomparefn= "ts_compar${cix}_cmp${reverse}__$table";
+%		if ($reverse) {
+%			next unless $col->{DoReverse};
+function <% $tcomparefn %>(a,b) { return -<% $comparefn %>(a,b); }
+%		}
+%		$thhtml .= "".
+%				($reverse ? '∨' : '∧'). '';
+%	}
+%	if (length $thhtml) {
+%		$add_heads{$cix}= $thhtml;
+%	}
+% }
+
+function ts_onload__<% $table %>() {
+  var ts_add_heads= <% to_json_protecttags(\%add_heads) %>;
+  var ctr= document.getElementById('<% defined($throw) ? $throw : $table %>');
+  var firstth= ctr.getElementsByTagName('th').item(0);
+  var thlist= firstth.parentNode.getElementsByTagName('th');
+  debug('thlist='+thlist);
+  debug('thlist.item(2)=' + thlist.item(2));
+  for (var cix in ts_add_heads) {
+    var ah = ts_add_heads[cix];
+    debug('appending to cix='+cix+' ah='+ah);
+    thlist.item(cix).innerHTML += ah;
+  }
+}
+
+register_onload(ts_onload__<% $table %>);
+
diff --git a/yarrg/yppedia-chart-parser b/yarrg/yppedia-chart-parser
new file mode 100755
index 0000000..41ef985
--- /dev/null
+++ b/yarrg/yppedia-chart-parser
@@ -0,0 +1,804 @@
+#!/usr/bin/perl
+#
+# Normally run from
+#  update-master-info
+#
+# usage: ./yppedia-chart-parser 
+#  updates OCEAN-Oceanname.db and _ocean-.txt
+#  from YPPedia (chart and ocean page) and source-info.txt
+
+# This is part of ypp-sc-tools, a set of third-party tools for assisting
+# players of Yohoho Puzzle Pirates.
+#
+# Copyright (C) 2009 Ian Jackson 
+#
+# 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 .
+#
+# Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+# are used without permission.  This program is not endorsed or
+# sponsored by Three Rings.
+
+use strict (qw(vars));
+use warnings;
+
+use Graph::Undirected;
+use Commods;
+use CommodsDatabase;
+
+my $widists= Graph::Undirected->new();
+my $wiarchs= Graph::Undirected->new();
+my $wispr;
+my $dbspr;
+my @wiarchlabels;
+my %wiisland2node;
+my %winode2island;
+my %winode2lines;
+my %wiccix2arch;
+my $wialldists;
+my %wtisland2arch;
+
+my $dbdists;
+my %dbisland2arch;
+
+my @msgkinds= qw(change warning error);
+my %msgs;
+my %msgprinted;
+my %msgkindprinted;
+sub pmsg ($$) {
+    my $m= "$_[0]: $_[1]\n";
+    print DEBUG "D $m";
+    push @{ $msgs{$_[0]} }, $m;
+}
+sub warning ($) { pmsg("warning",$_[0]); }
+sub error   ($) { pmsg("error",  $_[0]); }
+sub change  ($) { pmsg("change", $_[0]); }
+sub print_messages () {
+    foreach my $k (@msgkinds) {
+	my $ms= $msgs{$k};
+	next unless $ms;
+	foreach my $m (sort @$ms) {
+	    next if $msgprinted{$m};
+	    print $m or die $!;
+	    $msgprinted{$m}++;
+	    $msgkindprinted{$k}++;
+	}
+    }
+}
+sub progress ($) { print "($_[0])\n"; }
+
+my $stdin_chart=0;
+
+open DEBUG, ">/dev/null" or die $!;
+
+while (@ARGV) {
+    last unless $ARGV[0] =~ m/^-/;
+    $_= shift @ARGV;
+    last if m/^--$/;
+    if ($_ eq '--debug') {
+	open DEBUG, ">&STDOUT" or die $!;
+	select(DEBUG); $|=1; select(STDOUT);
+    } elsif ($_ eq '--stdin-chart') {
+	$stdin_chart=1;
+    } else {
+	die;
+    }
+}
+$|=1;
+
+@ARGV==1 or die;
+my $ocean= shift @ARGV;
+
+
+my $parity;
+sub nn_xy ($$) {
+    my ($x,$y) = @_;
+    my $tp= (0+$x ^ 0+$y) & 1;
+    defined $parity or $parity=$tp;
+    $tp==$parity or warning("line $.: parity error $x,$y is $tp not $parity");
+    my $n= "$_[0],$_[1]";
+    $winode2lines{$n}{$.}++;
+    return $n;
+}
+
+sub yppedia_chart_parse () {
+    # We don't even bother with tag soup; instead we do line-oriented parsing.
+
+    while () {
+	s/\<--.*--\>//g;
+	s/^\s*//; chomp; s/\s+$//; s/\s+/ /g;
+	s/\<\/?(?:b|em)\>//g;
+	s/\{\{chart\ style\|[^{}]*\}\}//gi;
+	next unless m/\{\{/; # only interested in chart template stuff
+
+	my ($x,$y, $arch,$island,$solid,$dirn);
+	my $nn= sub { return nn_xy($x,$y) };
+    
+	if (($x,$y,$arch) =
+	    m/^\{\{ chart\ label \|(\d+)\|(\d+)\| .*
+	            (?: \<(?: big|center )\>)* \'+
+	            (?: \[\[ | \{\{ )
+	            [^][\']* \| ([^][\'|]+)\ archipelago
+	            (?: \]\] | \}\} )
+	            \'+ (?: \<\/(?: big|center )\>)* \}\}$/xi) {
+	    printf DEBUG "%2d,%-2d arch %s\n", $x,$y,$arch;
+	    push @wiarchlabels, [ $x,$y,$arch ];
+	} elsif (m/^\{\{ chart\ label \|\d+\|\d+\|
+		 \ \'+ \[\[ .* \b ocean \]\]/xi) {
+	} elsif (($x,$y,$island) =
+	    m/^\{\{ chart\ island\ icon \|(\d+)\|(\d+)\|
+		    ([^| ][^|]*[^| ]) \| .*\}\}$/xi) {
+	    my $n= $nn->();
+	    $wiisland2node{$island}= $n;
+	    $winode2island{$n}= $island;
+	    $widists->add_vertex($n);
+	    $wiarchs->add_vertex($n);
+	    printf DEBUG "%2d,%-2d island %s\n", $x,$y,$island;
+	} elsif (($solid,$x,$y,$dirn) =
+	    m/^\{\{ chart\ league((?:\ solid)?) \|(\d+)\|(\d+)\|
+		    ([-\/\\o]) \| .*\}\}$/xi) {
+	    next if $dirn eq 'o';
+
+	    my ($bx,$by) = ($x,$y);
+	    if ($dirn eq '-') { $bx+=2; }
+	    elsif ($dirn eq '\\') { $bx++; $by++; }
+	    elsif ($dirn eq '/') { $x++; $by++; }
+	    else { die; }
+
+	    my $nb= nn_xy($bx,$by);
+	    $widists->add_weighted_edge($nn->(), $nb, 1);
+	    $wiarchs->add_edge($nn->(), $nb) if $solid;
+	    $wiarchs->add_edge($nn->(), $nb) if $solid;
+
+	    printf DEBUG "%2d,%-2d league %-6s %s %s\n", $x,$y,
+	        $solid?'solid':'dotted', $dirn, $nb;
+	} elsif (
+	    m/^\{\{ chart\ head \}\}$/xi
+		 ) {
+	    next;
+	} else {
+	    warning("line $.: ignoring incomprehensible: $_");
+	}
+    }
+}
+
+sub yppedia_graphs_add_shortcuts () {
+    # We add edges between LPs we know about, as you can chart
+    # between them.  Yppedia often lacks these edges.
+    #
+    foreach my $p ($widists->vertices) {
+	my ($ax,$ay) = $p =~ m/^(\d+)\,(\d+)$/ or die;
+	my $add_shortcut= sub {
+	    my $q= sprintf "%d,%d", $ax+$_[0], $ay+$_[1];
+	    return unless $widists->has_vertex($q);
+	    return if $widists->has_edge($p,$q);
+	    printf DEBUG "%-5s league-shortcut %-5s\n", $p, $q;
+	    $widists->add_weighted_edge($p,$q,1);
+	};
+	$add_shortcut->( 2,0);
+	$add_shortcut->(+1,1);
+	$add_shortcut->(-1,1);
+    }
+}
+
+sub yppedia_graphs_prune_boring () {
+    # Prune the LP database by eliminating boring intermediate vertices
+    foreach my $delete ($widists->vertices()) {
+	next if exists $winode2island{$delete};
+	my @neigh= $widists->neighbours($delete);
+	next unless @neigh==2;
+	my $weight= 0;
+	map { $weight += $widists->get_edge_weight($delete, $_) } @neigh;
+	$widists->add_weighted_edge(@neigh, $weight);
+	$widists->delete_vertex($delete);
+	printf DEBUG "%-5s elide %5s %-5s %2d\n", $delete, @neigh, $weight;
+    }
+}
+
+sub yppedia_graphs_check () {
+    # Check that it's connected.
+    foreach my $cc ($widists->connected_components()) {
+	next if 2*@$cc > $widists->vertices();
+	my $m= "disconnected league point(s):";
+	foreach my $n (@$cc) {
+	    $m .= "\n    LP $n, def. yppedia line(s): ".
+		join(',', sort keys %{ $winode2lines{$n} });
+	}
+	warning($m);
+    }
+}
+
+sub yppedia_archs_sourceinfo () {
+    # Assign archipelagoes according to the source-info file
+    foreach my $arch (sort keys %{ $oceans{$ocean} }) {
+	foreach my $islename (sort keys %{ $oceans{$ocean}{$arch} }) {
+	    my $islenode= $wiisland2node{$islename};
+	    if (!defined $islenode) {
+		error("island $islename in source-info but not in WP map");
+		next;
+	    }
+	    my $ccix= $wiarchs->connected_component_by_vertex($islenode);
+	    my $oldarch= $wiccix2arch{$ccix};
+	    error("island in $arch in source-info".
+		  " connected to $oldarch as well: $islename")
+		if defined $oldarch && $oldarch ne $arch;
+	    printf DEBUG "%-5s force-island-arch cc%-2d %-10s %s\n",
+	        $islenode, $ccix, $arch, $islename;
+	    $wiccix2arch{$ccix}= $arch;
+	}
+    }
+}
+
+sub yppedia_archs_chart_labels () {
+    # Assign archipelago labels to groups of islands
+    #
+    foreach my $label (@wiarchlabels) {
+	my ($ax,$ay,$arch) = @$label;
+	my $best_d2= 9999999;
+	my $best_n;
+#	print DEBUG "$ax,$ay arch-island-search $arch\n";
+	$ay += 1;  $ax += 2;  # coords are rather to the top left of label
+	foreach my $vertex ($wiarchs->vertices()) {
+	    next unless exists $winode2island{$vertex};
+	    my $ccix= $wiarchs->connected_component_by_vertex($vertex);
+	    my @cc= $wiarchs->connected_component_by_index($ccix);
+	    my ($vx,$vy) = split /,/, $vertex;
+	    my $d2= ($vx-$ax)*($vx-$ax) + ($vy-$ay)*($vy-$ay);
+	    my $cmp= $best_d2 <=> $d2;
+	    printf DEBUG "%2d,%-2d arch-island-search %5s d2=%4d cc%-2d".
+		         " #cc=%2d cmp=%2d %s\n",
+	        $ax,$ay, $vertex, $d2, $ccix, scalar(@cc), $cmp,
+	        $winode2island{$vertex};
+	    next unless $cmp > 0;
+	    $best_n=       $vertex;
+	    $best_d2=      $d2;
+	}
+	die 'no island vertices?!' unless defined $best_n;
+	my $ccix= $wiarchs->connected_component_by_vertex($best_n);
+	printf DEBUG
+	    "%2d,%-2d arch-island-select %-5s d2=%4d cc%-2d     %-10s %s\n",
+	    $ax,$ay, $best_n, $ccix, $best_d2, $arch, $winode2island{$best_n};
+	my $desc= join "\n", map {
+	    my $in= $winode2island{$_};
+	    "    LP $_". (defined $in ? ", $in" : "");
+	} sort $wiarchs->connected_component_by_index($ccix);
+
+	if (exists $wiccix2arch{$ccix} and $wiccix2arch{$ccix} ne $arch) {
+	    error("archipelago determination failed, wrongly merged:\n".
+		  "    archipelago $arch\n".
+		  "    archipelago $wiccix2arch{$ccix}\n".
+		  $desc);
+	    next;
+	}
+	$wiccix2arch{$ccix}= $arch;
+#	print "$ccix $arch ::\n$desc\n";
+    }
+}
+
+sub yppedia_archs_fillbynearest() {
+    # Assign islands not labelled above to archipelagoes.
+    #
+    # We do this by, for each connected component (set of islands
+    # linked by purchaseable charts), searching for the nearest other
+    # connected component which has already been assigned an arch.
+    # `Nearest' means shortest distance of unpurchaseable charts, in
+    # leagues.
+    #
+    # we need only consider vertices which weren't `boring intermediate
+    # vertices' (removed during optimisation as being of order 2)
+    my @ccs_useful= map {
+	[ grep { $widists->has_vertex($_) } @$_ ]
+    } $wiarchs->connected_components();
+
+    my @assignments;
+
+    foreach my $sourceccix (0..$#ccs_useful) {
+	next if defined $wiccix2arch{$sourceccix};
+	next unless $ccs_useful[$sourceccix];
+
+	my @sourcecc= $wiarchs->connected_component_by_index($sourceccix);
+	my @islandnodes= grep { $winode2island{$_} } @sourcecc;
+	next unless @islandnodes; # don't care, then
+
+	foreach my $islandnode (@islandnodes) {
+	    printf DEBUG "%-5s arch-join-need cc%-2d             %s\n",
+	        $islandnode, $sourceccix, $winode2island{$islandnode};
+	}
+	my $best_dist= 9999999;
+	my ($best_target, $best_targetccix, $best_source);
+	foreach my $targetccix (0..$#ccs_useful) {
+	    next unless defined $wiccix2arch{$targetccix}; # not helpful
+	    next unless $ccs_useful[$targetccix];
+	    foreach my $target ($wiarchs->
+			 connected_component_by_index($targetccix)) {
+		next unless $widists->has_vertex($target);
+		foreach my $source (@sourcecc) {
+		    my $target_dist= widist($target,$source);
+		    next unless defined $target_dist;
+		    next if $target_dist >= $best_dist;
+		    $best_dist= $target_dist;
+		    $best_source= $source;
+		    $best_target= $target;
+		    $best_targetccix= $targetccix;
+		}
+	    }
+	}
+	die "no possible target ?!" unless defined $best_target;
+
+	my $arch= $wiccix2arch{$best_targetccix};
+	my $best_island= $winode2island{$best_target};
+	printf DEBUG "%-5s arch-join-to %-5s dist=%2d cc%-2d  %-10s %s\n",
+	    $best_source, $best_target, $best_dist,
+	    $best_targetccix, $arch,
+	    defined($best_island) ? $best_island : "-";
+
+	push @assignments, [ $sourceccix, $arch ];
+    }
+    foreach my $assign (@assignments) {
+	$wiccix2arch{$assign->[0]}= $assign->[1];
+    }
+}
+
+sub yppedia_graph_shortest_paths () {
+    $wialldists= $widists->APSP_Floyd_Warshall();
+}
+
+sub widist ($$) {
+    my ($p,$q) = @_;
+    my $pl= $wialldists->path_length($p,$q);
+#    die "$p $q" unless defined $pl;
+#    my @pv= $wialldists->path_vertices($p,$q);
+#    if (@pv == $pl) { return $pl; }
+#   printf DEBUG "%-5s PATHLENGTH %-5s pl=%s pv=%s\n", $p,$q,$pl,join('|',@pv);
+    return $pl;
+}
+			
+sub winode2arch ($) {
+    my ($node) = @_;
+    my $ccix= $wiarchs->connected_component_by_vertex($node);
+    return $wiccix2arch{$ccix};
+}
+sub wiisland2arch ($) {
+    my ($island) = @_;
+    my $node= $wiisland2node{$island};
+    die "$island ?" unless defined $node;
+    return winode2arch($node);
+}
+
+sub compare_island_lists () {
+    foreach my $island (sort keys %dbisland2arch) {
+	my $node= $wiisland2node{$island};
+	if (!defined $node) {
+	    error("would delete island: $island");
+	    next;
+	}
+	my $wiarch= winode2arch($node);
+	if (!defined $wiarch) {
+	    error("island has no arch: $island");
+	    next;
+	}
+	my $dbarch= $dbisland2arch{$island};
+	if ($wiarch ne $dbarch) {
+	    change("archipelago change from $dbarch to $wiarch".
+		   " for island $island");
+	}
+    }
+    foreach my $island (sort keys %wiisland2node) {
+	my $wtarch= $wtisland2arch{$island};
+	my $wiarch= wiisland2arch($island);
+	if (!$stdin_chart) {
+	    if (!defined $wtarch) {
+		error("island from chart not found on ocean page: $island");
+	    } elsif (defined $wiarch and $wtarch ne $wiarch) {
+		error("island in $wtarch on ocean page but".
+		      " concluded $wiarch from chart: $island");
+	    }
+	}
+
+	my $dbarch= $dbisland2arch{$island};
+	if (!defined $dbarch) {
+	    my $wiarch= wiisland2arch($island);
+	    if (!defined $wiarch) {
+		error("new island has no arch: $island");
+		next;
+		# We check arches of non-new islands above
+	    }
+	    change("island new in $wiarch: $island");
+	}
+    }
+    if (!$stdin_chart) {
+	foreach my $island (sort keys %wtisland2arch) {
+	    my $node= $wiisland2node{$island};
+	    next if defined $node;
+	    error("island on ocean page but not in chart: $island");
+	}
+    }
+}
+
+sub shortest_path_reduction ($$) {
+    my ($what,$g) = @_;
+    #
+    # Takes a graph $g (and a string for messages $what) and returns
+    # a new graph which is the miminal shortest path transient reduction
+    # of $g.
+    #
+    # We also check that the shortest path closure of the intended result
+    # is the same graph as the input.  Thus the input must itself be
+    # a shortest path closure; if it isn't, we die.
+
+    my $proof=<<'END'; # way to make a big comment
+
+    Premises and definitions:
+
+    1. F is an undirected weighted graph with positive edge weights.
+
+    2. All graphs we will consider have the same vertices as F
+       and none have self-edges.
+
+    3. G = Closure(F) is the graph of cliques whose edge weights
+       are the shortest paths in F, one clique for each connected
+       component in F.
+
+    3a. |XY| for vertices X, Y is the weight of the edge XY in G.
+       If XY is not in G, |XY| is infinite.
+
+    4. A `reduction' of G is a subgraph K of G such that Closure(K) = G.
+       The reduction is `minimal' if there is no strict subgraph K'
+       of K such that Closure(K') = G.
+
+    5. Now each edge of G may be:
+       - `unnecessary': included in no minimal reductions of G.
+       - `essential': included in all minimal reductions of G.
+       - `contingent': included in some but not all.
+
+    6. Consider for any edge AC between the vertices A and C,
+       whether there is any B such that |AB|+|BC| = |AC| ?
+       (There can be no B such that the sum < |AC| since that would
+       mean that |AC| wasn't equal to the shortest path length.)
+
+    6a. No such B:  AC is therefore the only shortest path from A to C
+	(since G is not a multigraph).  AC is thus an essential edge.
+
+    6b. Some such B: Call all such edges AC `questionable'.
+
+    6c. Thus all edges are essential or questionable.
+
+    7. Suppose AC is a shortest contingent edge.  AC must be
+       questionable since it is not essential.  Suppose it is
+       made questionable by the existence of B such that |AB|+|BC| =
+       |AC|.  Consider AB and BC.  Since |AB| and |BC| are positive,
+       |BC| and |AB| must be < |AC| ie AB and BC are shorter than AC.
+       Since AC is a shortest contingent edge, there must be shortest
+       paths in G for AB and BC consisting entirely of essential edges.
+
+    8. Therefore it is always safe to remove AC since the paths
+       A..B and B..C will definitely still remain and provide a path
+       A..B..C with length |AB|+|BC| = |AC|.
+
+    9. Thus AC is unnecessary, contradicting the assumption in 7.
+       There are therefore no shortest contingent edges, and
+       thus no contingent edges.
+
+    10. We can construct a minimal reduction directly: for each edge
+        AC in G, search for a vertex B such that |AB|+|BC| = |AC|.
+        If we find none, AC is essential.  If we find one then AC is
+        not essential and is therefore unnecessary.
+
+END
+    
+    printf DEBUG "spr %s before %d\n", $what, scalar($g->edges());
+
+    my $result= Graph::Undirected->new();
+    foreach my $edge_ac ($g->edges()) {
+        $result->add_vertex($edge_ac->[0]); # just in case
+        next if $edge_ac->[0] eq $edge_ac->[1];
+	my $edgename_ac= join ' .. ', @$edge_ac;
+	printf DEBUG "spr %s edge %s\n", $what, $edgename_ac;
+	my $w_ac= $g->get_edge_weight(@$edge_ac);
+	my $needed= 1;
+	foreach my $vertex_b ($g->vertices()) {
+	    next if grep { $_ eq $vertex_b } @$edge_ac;
+	    my $w_ab= $g->get_edge_weight($edge_ac->[0], $vertex_b);
+	    next unless defined $w_ab;
+	    next if $w_ab >= $w_ac;
+	    my $w_bc= $g->get_edge_weight($vertex_b, $edge_ac->[1]);
+	    next unless defined $w_ac;
+	    next if $w_ab + $w_bc > $w_ac;
+	    # found path
+	    printf DEBUG "spr %s edge %s unnecessary %s\n",
+	        $what, $edgename_ac, $vertex_b;
+	    $needed= 0;
+	    last;
+	}
+	if ($needed) {
+	    printf DEBUG "spr %s edge %s essential\n", $what, $edgename_ac;
+	    $result->add_weighted_edge(@$edge_ac,$w_ac);
+	}
+    }
+    printf DEBUG "spr %s result %d\n", $what, scalar($result->edges());
+
+    my $apsp= $result->APSP_Floyd_Warshall();
+    foreach my $ia (sort $g->vertices()) {
+	foreach my $ib (sort $g->vertices()) {
+	    my $din= $g->get_edge_weight($ia,$ib);
+	    my $dout= $apsp->path_length($ia,$ib);
+	    $din= defined($din) ? $din : 'infinity';
+	    $dout= defined($dout) ? $dout : 'infinity';
+	    error("$what spr apsp discrepancy in=$din out=$dout".
+                  " for $ia .. $ib")
+		if $din != $dout;
+	}
+    }
+    return $result;
+}
+
+sub yppedia_graph_spr () {
+    my $base= Graph::Undirected->new();
+    foreach my $na (sort keys %winode2island) {
+	my $ia= $winode2island{$na};
+	foreach my $nb (sort keys %winode2island) {
+	    my $ib= $winode2island{$nb};
+	    $base->add_weighted_edge($ia,$ib, widist($na,$nb));
+	}
+    }
+    $wispr= shortest_path_reduction('wi',$base);
+}
+
+sub yppedia_ocean_fetch_start ($) {
+    my ($chart) = @_;
+    my @args= ();
+    push @args, '--chart' if $chart;
+    push @args, $ocean;
+    open OCEAN, '-|', "./yppedia-ocean-scraper", @args or die $!;
+}
+sub yppedia_ocean_fetch_done () {
+    $?=0; $!=0; close OCEAN; $? and die $?; $! and die $!;
+}
+
+sub yppedia_ocean_fetch_chart () {
+    if ($stdin_chart) {
+	open OCEAN, "<& STDIN" or die $!;
+	yppedia_chart_parse();
+    } else {
+	yppedia_ocean_fetch_start(1);
+	yppedia_chart_parse();
+	yppedia_ocean_fetch_done();
+    }
+}
+
+sub yppedia_ocean_fetch_text () {
+    yppedia_ocean_fetch_start(0);
+    my $arch;
+    while () {
+	chomp;
+	if (m/^ocean /) {
+	    $' eq $ocean or die;
+	} elsif (m/^  /) {
+	    die unless defined $arch;
+	    $wtisland2arch{$'}= $arch;
+	} elsif (m/^ /) {
+	    $arch= $';
+	} else {
+	    die;
+	}
+    }
+    yppedia_ocean_fetch_done();
+}
+
+sub compare_distances () {
+    foreach my $ia (sort keys %dbisland2arch) {
+	my $na= $wiisland2node{$ia};
+	next unless defined $na;
+	foreach my $ib (sort keys %dbisland2arch) {
+	    next unless $ia le $ib; # do every pair only once
+	    my $dbdist= $dbspr->get_edge_weight($ia,$ib);
+	    my $widist= $wispr->get_edge_weight($ia,$ib);
+	    next unless defined $dbdist || defined $widist;
+	    
+	    if (!defined $widist) {
+		warning(sprintf "route delete %2d for %s .. %s",
+			$dbdist, $ia,$ib);
+	    } elsif (!defined $dbdist) {
+		change(sprintf "route new %2d for %s .. %s",
+		       $widist, $ia,$ib);
+	    } elsif ($dbdist != $widist) {
+		change(sprintf "route change %2d to %2d for %s .. %s",
+		       $dbdist, $widist, $ia,$ib);
+	    }
+	}
+    }
+}
+
+#========== database handling ==========
+
+sub database_fetch_ocean () {
+    my ($row,$sth);
+    $sth= $dbh->prepare('SELECT islandname, archipelago FROM islands');
+    $sth->execute();
+    undef %dbisland2arch;
+    $dbdists= Graph::Undirected->new();
+    while ($row= $sth->fetchrow_hashref) {
+	print DEBUG "database-island $row->{'islandname'}".
+	             " $row->{'archipelago'}\n";
+	$dbisland2arch{$row->{'islandname'}}= $row->{'archipelago'};
+    }
+    $sth= $dbh->prepare('SELECT dist, a.islandname a, b.islandname b
+ 				FROM dists
+				JOIN islands AS a ON dists.aiid==a.islandid
+				JOIN islands AS b ON dists.biid==b.islandid');
+    $sth->execute();
+    while ($row= $sth->fetchrow_hashref) {
+	$dbdists->add_weighted_edge($row->{'a'}, $row->{'b'}, $row->{'dist'});
+    }
+}			 
+
+sub database_graph_spr () {
+    $dbspr= shortest_path_reduction('db',$dbdists);
+}
+
+sub database_do_updates () {
+    my $addisland= $dbh->prepare(<<'END')
+ INSERT OR IGNORE INTO islands (islandname, archipelago) VALUES (?, ?);
+END
+    ;
+    foreach my $island (sort keys %wiisland2node) {
+	my $wiarch= wiisland2arch($island);
+	$addisland->execute($island, $wiarch);
+    }
+
+    db_doall(<prepare(<<'END')
+ INSERT INTO dists VALUES
+	((SELECT islandid FROM islands WHERE islandname == ?),
+	 (SELECT islandid FROM islands WHERE islandname == ?),
+	 ?);
+END
+    ;
+    my $addroute= $dbh->prepare(<<'END')
+ INSERT INTO routes VALUES
+	((SELECT islandid FROM islands WHERE islandname == ?),
+	 (SELECT islandid FROM islands WHERE islandname == ?),
+	 ?);
+END
+    ;
+    foreach my $ia (sort keys %wiisland2node) {
+	my $na= $wiisland2node{$ia};
+	foreach my $ib (sort keys %wiisland2node) {
+	    my $nb= $wiisland2node{$ib};
+	    my $apdist= $ia eq $ib ? 0 : widist($na,$nb);
+	    die "$ia $ib" unless defined $apdist;
+	    my $sprdist= $wispr->get_edge_weight($ia,$ib);
+	    die "$ia $ib $apdist $sprdist" if
+		defined($sprdist) && $sprdist != $apdist;
+
+	    $adddist->execute($ia,$ib,$apdist);
+	    $addroute->execute($ia,$ib,$sprdist) if defined $sprdist;
+	}
+    }
+
+    # select ia.islandname, ib.islandname, d.dist from dists as d, islands as ia on d.aiid = ia.islandid, islands as ib on d.biid = ib.islandid order by ia.islandname, ib.islandname;
+    
+}
+
+#========== update _ocean-*.txt ==========
+
+our $localtopo_path;
+
+sub localtopo_rewrite () {
+    $localtopo_path= '_ocean-'.(lc $ocean).'.txt';
+    my $fh= new IO::File "$localtopo_path.tmp", 'w';
+    print $fh "# autogenerated - do not edit\n" or die $!;
+    print $fh "ocean $ocean\n" or die $!;
+    my %arches;
+    foreach my $isle (sort keys %wtisland2arch) {
+	my $arch= $wtisland2arch{$isle};
+	push @{ $arches{$arch} }, $isle;
+    }
+    foreach my $arch (sort keys %arches) {
+	print $fh " $arch\n" or die $!;
+	foreach my $isle (@{ $arches{$arch} }) {
+	    print $fh "  $isle\n" or die $!;
+	}
+    }
+    print $fh "\n" or die $!;
+    close $fh or die $!;
+}
+
+sub localtopo_commit () {
+    rename "$localtopo_path.tmp", $localtopo_path or die $!;
+}
+
+#========== main program ==========
+
+parse_info_serverside();
+
+progress("fetching yppedia chart");         yppedia_ocean_fetch_chart();
+progress("adding shortcuts");               yppedia_graphs_add_shortcuts();
+progress("pruning boring vertices");        yppedia_graphs_prune_boring();
+progress("checking yppedia graphs");        yppedia_graphs_check();
+progress("setting archs from source-info"); yppedia_archs_sourceinfo();
+progress("computing shortest paths");       yppedia_graph_shortest_paths();
+progress("setting archs from labels");      yppedia_archs_chart_labels();
+progress("setting archs from nearby");      yppedia_archs_fillbynearest();
+progress("computing yppedia spr");          yppedia_graph_spr();
+
+if (!$stdin_chart) {
+    progress("fetching yppedia ocean text");    yppedia_ocean_fetch_text();
+}
+
+db_setocean($ocean);
+db_connect();
+my $iteration=0;
+for (;;) {
+    progress("reading database");
+    database_fetch_ocean();
+    progress("computing database spr");         database_graph_spr();
+
+    progress("comparing islands");              compare_island_lists();
+    progress("comparing distances");            compare_distances();
+
+    print "\n";
+    print_messages();
+
+    foreach my $k (@msgkinds) {
+	my $n= $msgkindprinted{$k};
+	next unless $n;
+	printf STDERR "*** %d%s %ss\n", $n, $iteration?' additional':'', $k;
+    }
+    
+    if ($msgs{'error'}) {
+	print STDERR "*** errors, aborting update\n";
+	exit 1;
+    }
+
+    if (!%msgkindprinted) {
+	progress("updating database");         database_do_updates();
+	progress("updating _ocean-*.txt");     localtopo_rewrite();
+	if ($stdin_chart) {
+	    print STDERR "*** --stdin-chart, aborting!\n";
+	    exit 1;
+	}
+	progress("committing database");       $dbh->commit();
+	progress("committing _ocean-*.txt");   localtopo_commit();
+	exit 0;
+    }
+    $dbh->rollback();
+
+    my $default= !$msgkindprinted{'warning'};
+    printf STDERR "*** confirm update %s ? ", $default?'(y/n)':'(n/y)';
+
+    if ($stdin_chart) {
+	printf STDERR "[--stdin-chart]\n";
+	exit 1;
+    }
+
+    $!=0; my $result= ;  defined $result or die $!;
+    $result =~ s/\s//g;
+    $result= $default?'y':'n' if !length $result;
+    $result= $result =~ m/^y/i;
+
+    if (!$result) {
+	printf STDERR "*** updated abandoned at your request\n";
+	exit 1;
+    }
+
+    print "\n";
+    undef %msgkindprinted;
+    $iteration++;
+}
+
+print_messages();
diff --git a/yarrg/yppedia-ocean-scraper b/yarrg/yppedia-ocean-scraper
new file mode 100755
index 0000000..476c1cd
--- /dev/null
+++ b/yarrg/yppedia-ocean-scraper
@@ -0,0 +1,192 @@
+#!/usr/bin/python
+
+# helper program for getting information from yppedia
+
+# This is part of ypp-sc-tools, a set of third-party tools for assisting
+# players of Yohoho Puzzle Pirates.
+#
+# Copyright (C) 2009 Ian Jackson 
+#
+# 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 .
+#
+# Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+# are used without permission.  This program is not endorsed or
+# sponsored by Three Rings.
+
+copyright_info = '''
+yppedia-ocean-scraper is part of ypp-sc-tools Copyright (C) 2009 Ian Jackson
+This program comes with ABSOLUTELY NO WARRANTY; this is free software,
+and you are welcome to redistribute it under certain conditions.  For
+details, read the top of the yppedia-ocean-scraper file.
+'''
+
+import signal
+signal.signal(signal.SIGINT, signal.SIG_DFL)
+
+import sys
+import os
+import urllib
+import urllib2
+import re as regexp
+from optparse import OptionParser
+from BeautifulSoup import BeautifulSoup
+
+
+# For fuck's sake!
+import codecs
+import locale
+def fix_stdout():
+    sys.stdout = codecs.EncodedFile(sys.stdout, locale.getpreferredencoding())
+    def null_decode(input, errors='strict'):
+        return input, len(input)
+    sys.stdout.decode = null_decode
+# From
+#  http://ewx.livejournal.com/457086.html?thread=3016574
+#  http://ewx.livejournal.com/457086.html?thread=3016574
+# lightly modified.
+# See also Debian #415968.
+fix_stdout()
+
+
+ocean = None
+soup = None
+opts = None
+arches = {}
+
+def debug(k,v):
+	if opts.debug:
+		print >>sys.stderr, k,`v`
+
+def fetch():
+	global soup
+	if opts.chart:
+		url_base = 'index.php?title=Template:Map:%s_Ocean&action=edit'
+	else:
+		url_base = '%s_Ocean'
+	url = ('http://yppedia.puzzlepirates.com/' +
+			(url_base % urllib.quote(ocean,'')))
+	debug('fetching',url)
+	dataf = urllib2.urlopen(url)
+	debug('fetched',dataf)
+	soup = BeautifulSoup(dataf)
+
+
+title_arch_re = regexp.compile('(\\S.*\\S) Archipelago \\((\\S+)\\)$')
+title_any_re = regexp.compile('(\\S.*\\S) \((\\S+)\\)$')
+href_img_re = regexp.compile('\\.png$')
+
+def title_arch_info(t):
+	# returns (arch,ocean)
+	debug('checking',t)
+	if t is None: return (None,None)
+	m = title_arch_re.match(t)
+	if not m: return (None,None)
+	return m.groups()
+
+def title_arch_ok(t):
+	(a,o) = title_arch_info(t)
+	if o is None: return False
+	return o == ocean
+
+def parse_chart():
+	ta = soup.find('textarea')
+	debug('ta',ta)
+	s = ta.string
+	debug('s',s)
+	s = regexp.sub(r'\<\;', '<', s)
+	s = regexp.sub(r'\>\;', '>', s)
+	s = regexp.sub(r'\"\;', '"', s)
+	s = regexp.sub(r'\&\;', '&', s)
+	debug('s',s)
+	return s
+
+def parse_ocean():
+	content = soup.find('div', attrs = {'id': 'content'})
+
+	def findall_title_arch_ok(t):
+		return t.findAll('a', attrs = {'title': title_arch_ok})
+
+	def is_archestable(u):
+		if u.name != 'table': return False
+		return len(findall_title_arch_ok(u)) > 1
+
+	archestable = content.findChild('table', attrs={'border':'1'})
+	debug('at',archestable)
+
+	archsoups = []
+	for row in archestable.findAll('tr',recursive=False):
+		archsoups += row.findAll('td',recursive=False)
+	debug('ac',archsoups)
+
+	def is_island(v):
+		return len(v.findAll(text = regexp.compile('.*Large'))) > 0
+	def arch_up_map(u):
+		return u.findParent(is_island)
+
+	for arch in archsoups:
+		links = arch.findAll('a', href=True)
+		debug('links',links)
+		if not links: continue
+		(a,o) = title_arch_info(links[0]['title'])
+		debug('arch-ocean', (a,o))
+		assert(o == ocean)
+		assert(a not in arches)
+		isles = []
+		for link in links[1:]:
+			debug('link',link)
+			if href_img_re.search(link['href']): continue
+			m = title_any_re.match(link['title'])
+			assert(m.group(2) == ocean)
+			island = m.group(1)
+			debug('island', island)
+			isles.append(island)
+		isles.sort()
+		arches[a] = isles
+
+def output():
+	print 'ocean',ocean
+	al = arches.keys()
+	al.sort()
+	for a in al:
+		print '',a
+		for island in arches[a]:
+			print ' ',island
+
+def main():
+	global ocean
+	global opts
+
+	pa = OptionParser(
+'''usage: .../yppedia-ocean-scraper [--debug] [--chart] OCEAN''')
+	ao = pa.add_option
+
+	ao('--chart', action='store_true', dest='chart',
+		help='print chart source rather than arch/island info')
+	ao('--debug', action='count', dest='debug', default=0,
+		help='enable debugging output')
+
+	(opts,args) = pa.parse_args()
+	if len(args) != 1:
+		print >>sys.stderr, copyright_info
+		pa.error('need an ocean argument')
+	ocean = args[0]
+
+	fetch()
+	if opts.chart:
+		print parse_chart()
+	else:
+		parse_ocean()
+		output()
+
+main()