| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | # $Id: AcceptLanguage.pm,v 1.8 2004/05/14 21:40:03 cgilmore Exp $ | 
| 2 |  |  |  |  |  |  | # | 
| 3 |  |  |  |  |  |  | # Author          : Christian Gilmore | 
| 4 |  |  |  |  |  |  | # Created On      : Wed Sep 25 17:10:19 CDT 2002 | 
| 5 |  |  |  |  |  |  | # | 
| 6 |  |  |  |  |  |  | # PURPOSE | 
| 7 |  |  |  |  |  |  | #     Matches language preference to available languages. | 
| 8 |  |  |  |  |  |  | # | 
| 9 |  |  |  |  |  |  | ############################################################################### | 
| 10 |  |  |  |  |  |  | # | 
| 11 |  |  |  |  |  |  | # IBM Public License Version 1.0 | 
| 12 |  |  |  |  |  |  | # | 
| 13 |  |  |  |  |  |  | # THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS IBM | 
| 14 |  |  |  |  |  |  | # PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR | 
| 15 |  |  |  |  |  |  | # DISTRIBUTION OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF | 
| 16 |  |  |  |  |  |  | # THIS AGREEMENT. | 
| 17 |  |  |  |  |  |  | # | 
| 18 |  |  |  |  |  |  | # 1. DEFINITIONS | 
| 19 |  |  |  |  |  |  | # | 
| 20 |  |  |  |  |  |  | # "Contribution" means: | 
| 21 |  |  |  |  |  |  | # | 
| 22 |  |  |  |  |  |  | #   a) in the case of International Business Machines Corporation | 
| 23 |  |  |  |  |  |  | #   ("IBM"), the Original Program, and | 
| 24 |  |  |  |  |  |  | # | 
| 25 |  |  |  |  |  |  | #   b) in the case of each Contributor, | 
| 26 |  |  |  |  |  |  | # | 
| 27 |  |  |  |  |  |  | #   i) changes to the Program, and | 
| 28 |  |  |  |  |  |  | # | 
| 29 |  |  |  |  |  |  | #   ii) additions to the Program; | 
| 30 |  |  |  |  |  |  | # | 
| 31 |  |  |  |  |  |  | #   where such changes and/or additions to the Program originate from | 
| 32 |  |  |  |  |  |  | #   and are distributed by that particular Contributor. A Contribution | 
| 33 |  |  |  |  |  |  | #   'originates' from a Contributor if it was added to the Program by | 
| 34 |  |  |  |  |  |  | #   such Contributor itself or anyone acting on such Contributor's | 
| 35 |  |  |  |  |  |  | #   behalf. Contributions do not include additions to the Program | 
| 36 |  |  |  |  |  |  | #   which: (i) are separate modules of software distributed in | 
| 37 |  |  |  |  |  |  | #   conjunction with the Program under their own license agreement, | 
| 38 |  |  |  |  |  |  | #   and (ii) are not derivative works of the Program. | 
| 39 |  |  |  |  |  |  | # | 
| 40 |  |  |  |  |  |  | # "Contributor" means IBM and any other entity that distributes the | 
| 41 |  |  |  |  |  |  | # Program. | 
| 42 |  |  |  |  |  |  | # | 
| 43 |  |  |  |  |  |  | # "Licensed Patents " mean patent claims licensable by a Contributor | 
| 44 |  |  |  |  |  |  | # which are necessarily infringed by the use or sale of its | 
| 45 |  |  |  |  |  |  | # Contribution alone or when combined with the Program. | 
| 46 |  |  |  |  |  |  | # | 
| 47 |  |  |  |  |  |  | # "Original Program" means the original version of the software | 
| 48 |  |  |  |  |  |  | # accompanying this Agreement as released by IBM, including source | 
| 49 |  |  |  |  |  |  | # code, object code and documentation, if any. | 
| 50 |  |  |  |  |  |  | # | 
| 51 |  |  |  |  |  |  | # "Program" means the Original Program and Contributions. | 
| 52 |  |  |  |  |  |  | # | 
| 53 |  |  |  |  |  |  | # "Recipient" means anyone who receives the Program under this | 
| 54 |  |  |  |  |  |  | # Agreement, including all Contributors. | 
| 55 |  |  |  |  |  |  | # | 
| 56 |  |  |  |  |  |  | # 2. GRANT OF RIGHTS | 
| 57 |  |  |  |  |  |  | # | 
| 58 |  |  |  |  |  |  | #   a) Subject to the terms of this Agreement, each Contributor hereby | 
| 59 |  |  |  |  |  |  | #   grants Recipient a non-exclusive, worldwide, royalty-free | 
| 60 |  |  |  |  |  |  | #   copyright license to reproduce, prepare derivative works of, | 
| 61 |  |  |  |  |  |  | #   publicly display, publicly perform, distribute and sublicense the | 
| 62 |  |  |  |  |  |  | #   Contribution of such Contributor, if any, and such derivative | 
| 63 |  |  |  |  |  |  | #   works, in source code and object code form. | 
| 64 |  |  |  |  |  |  | # | 
| 65 |  |  |  |  |  |  | #   b) Subject to the terms of this Agreement, each Contributor hereby | 
| 66 |  |  |  |  |  |  | #   grants Recipient a non-exclusive, worldwide, royalty-free patent | 
| 67 |  |  |  |  |  |  | #   license under Licensed Patents to make, use, sell, offer to sell, | 
| 68 |  |  |  |  |  |  | #   import and otherwise transfer the Contribution of such | 
| 69 |  |  |  |  |  |  | #   Contributor, if any, in source code and object code form. This | 
| 70 |  |  |  |  |  |  | #   patent license shall apply to the combination of the Contribution | 
| 71 |  |  |  |  |  |  | #   and the Program if, at the time the Contribution is added by the | 
| 72 |  |  |  |  |  |  | #   Contributor, such addition of the Contribution causes such | 
| 73 |  |  |  |  |  |  | #   combination to be covered by the Licensed Patents. The patent | 
| 74 |  |  |  |  |  |  | #   license shall not apply to any other combinations which include | 
| 75 |  |  |  |  |  |  | #   the Contribution. No hardware per se is licensed hereunder. | 
| 76 |  |  |  |  |  |  | # | 
| 77 |  |  |  |  |  |  | #   c) Recipient understands that although each Contributor grants the | 
| 78 |  |  |  |  |  |  | #   licenses to its Contributions set forth herein, no assurances are | 
| 79 |  |  |  |  |  |  | #   provided by any Contributor that the Program does not infringe the | 
| 80 |  |  |  |  |  |  | #   patent or other intellectual property rights of any other entity. | 
| 81 |  |  |  |  |  |  | #   Each Contributor disclaims any liability to Recipient for claims | 
| 82 |  |  |  |  |  |  | #   brought by any other entity based on infringement of intellectual | 
| 83 |  |  |  |  |  |  | #   property rights or otherwise. As a condition to exercising the | 
| 84 |  |  |  |  |  |  | #   rights and licenses granted hereunder, each Recipient hereby | 
| 85 |  |  |  |  |  |  | #   assumes sole responsibility to secure any other intellectual | 
| 86 |  |  |  |  |  |  | #   property rights needed, if any. For example, if a third party | 
| 87 |  |  |  |  |  |  | #   patent license is required to allow Recipient to distribute the | 
| 88 |  |  |  |  |  |  | #   Program, it is Recipient's responsibility to acquire that license | 
| 89 |  |  |  |  |  |  | #   before distributing the Program. | 
| 90 |  |  |  |  |  |  | # | 
| 91 |  |  |  |  |  |  | #   d) Each Contributor represents that to its knowledge it has | 
| 92 |  |  |  |  |  |  | #   sufficient copyright rights in its Contribution, if any, to grant | 
| 93 |  |  |  |  |  |  | #   the copyright license set forth in this Agreement. | 
| 94 |  |  |  |  |  |  | # | 
| 95 |  |  |  |  |  |  | # 3. REQUIREMENTS | 
| 96 |  |  |  |  |  |  | # | 
| 97 |  |  |  |  |  |  | # A Contributor may choose to distribute the Program in object code | 
| 98 |  |  |  |  |  |  | # form under its own license agreement, provided that: | 
| 99 |  |  |  |  |  |  | # | 
| 100 |  |  |  |  |  |  | #   a) it complies with the terms and conditions of this Agreement; | 
| 101 |  |  |  |  |  |  | # | 
| 102 |  |  |  |  |  |  | # and | 
| 103 |  |  |  |  |  |  | # | 
| 104 |  |  |  |  |  |  | #   b) its license agreement: | 
| 105 |  |  |  |  |  |  | # | 
| 106 |  |  |  |  |  |  | #   i) effectively disclaims on behalf of all Contributors all | 
| 107 |  |  |  |  |  |  | #   warranties and conditions, express and implied, including | 
| 108 |  |  |  |  |  |  | #   warranties or conditions of title and non-infringement, and | 
| 109 |  |  |  |  |  |  | #   implied warranties or conditions of merchantability and fitness | 
| 110 |  |  |  |  |  |  | #   for a particular purpose; | 
| 111 |  |  |  |  |  |  | # | 
| 112 |  |  |  |  |  |  | #   ii) effectively excludes on behalf of all Contributors all | 
| 113 |  |  |  |  |  |  | #   liability for damages, including direct, indirect, special, | 
| 114 |  |  |  |  |  |  | #   incidental and consequential damages, such as lost profits; | 
| 115 |  |  |  |  |  |  | #   iii) states that any provisions which differ from this Agreement | 
| 116 |  |  |  |  |  |  | #   are offered by that Contributor alone and not by any other party; | 
| 117 |  |  |  |  |  |  | #   and | 
| 118 |  |  |  |  |  |  | # | 
| 119 |  |  |  |  |  |  | #   iv) states that source code for the Program is available from such | 
| 120 |  |  |  |  |  |  | #   Contributor, and informs licensees how to obtain it in a | 
| 121 |  |  |  |  |  |  | #   reasonable manner on or through a medium customarily used for | 
| 122 |  |  |  |  |  |  | #   software exchange. | 
| 123 |  |  |  |  |  |  | # | 
| 124 |  |  |  |  |  |  | # When the Program is made available in source code form: | 
| 125 |  |  |  |  |  |  | # | 
| 126 |  |  |  |  |  |  | #   a) it must be made available under this Agreement; and | 
| 127 |  |  |  |  |  |  | # | 
| 128 |  |  |  |  |  |  | #   b) a copy of this Agreement must be included with each copy of the | 
| 129 |  |  |  |  |  |  | #   Program. | 
| 130 |  |  |  |  |  |  | # | 
| 131 |  |  |  |  |  |  | # Each Contributor must include the following in a conspicuous | 
| 132 |  |  |  |  |  |  | # location in the Program: | 
| 133 |  |  |  |  |  |  | # | 
| 134 |  |  |  |  |  |  | #   Copyright © {date here}, International Business Machines | 
| 135 |  |  |  |  |  |  | #   Corporation and others. All Rights Reserved. | 
| 136 |  |  |  |  |  |  | # | 
| 137 |  |  |  |  |  |  | # In addition, each Contributor must identify itself as the originator | 
| 138 |  |  |  |  |  |  | # of its Contribution, if any, in a manner that reasonably allows | 
| 139 |  |  |  |  |  |  | # subsequent Recipients to identify the originator of the | 
| 140 |  |  |  |  |  |  | # Contribution. | 
| 141 |  |  |  |  |  |  | # | 
| 142 |  |  |  |  |  |  | # 4. COMMERCIAL DISTRIBUTION | 
| 143 |  |  |  |  |  |  | # | 
| 144 |  |  |  |  |  |  | # Commercial distributors of software may accept certain | 
| 145 |  |  |  |  |  |  | # responsibilities with respect to end users, business partners and | 
| 146 |  |  |  |  |  |  | # the like. While this license is intended to facilitate the | 
| 147 |  |  |  |  |  |  | # commercial use of the Program, the Contributor who includes the | 
| 148 |  |  |  |  |  |  | # Program in a commercial product offering should do so in a manner | 
| 149 |  |  |  |  |  |  | # which does not create potential liability for other Contributors. | 
| 150 |  |  |  |  |  |  | # Therefore, if a Contributor includes the Program in a commercial | 
| 151 |  |  |  |  |  |  | # product offering, such Contributor ("Commercial Contributor") hereby | 
| 152 |  |  |  |  |  |  | # agrees to defend and indemnify every other Contributor ("Indemnified | 
| 153 |  |  |  |  |  |  | # Contributor") against any losses, damages and costs (collectively | 
| 154 |  |  |  |  |  |  | # "Losses") arising from claims, lawsuits and other legal actions | 
| 155 |  |  |  |  |  |  | # brought by a third party against the Indemnified Contributor to the | 
| 156 |  |  |  |  |  |  | # extent caused by the acts or omissions of such Commercial | 
| 157 |  |  |  |  |  |  | # Contributor in connection with its distribution of the Program in a | 
| 158 |  |  |  |  |  |  | # commercial product offering. The obligations in this section do not | 
| 159 |  |  |  |  |  |  | # apply to any claims or Losses relating to any actual or alleged | 
| 160 |  |  |  |  |  |  | # intellectual property infringement. In order to qualify, an | 
| 161 |  |  |  |  |  |  | # Indemnified Contributor must: a) promptly notify the Commercial | 
| 162 |  |  |  |  |  |  | # Contributor in writing of such claim, and b) allow the Commercial | 
| 163 |  |  |  |  |  |  | # Contributor to control, and cooperate with the Commercial | 
| 164 |  |  |  |  |  |  | # Contributor in, the defense and any related settlement negotiations. | 
| 165 |  |  |  |  |  |  | # The Indemnified Contributor may participate in any such claim at its | 
| 166 |  |  |  |  |  |  | # own expense. | 
| 167 |  |  |  |  |  |  | # | 
| 168 |  |  |  |  |  |  | # For example, a Contributor might include the Program in a commercial | 
| 169 |  |  |  |  |  |  | # product offering, Product X. That Contributor is then a Commercial | 
| 170 |  |  |  |  |  |  | # Contributor. If that Commercial Contributor then makes performance | 
| 171 |  |  |  |  |  |  | # claims, or offers warranties related to Product X, those performance | 
| 172 |  |  |  |  |  |  | # claims and warranties are such Commercial Contributor's | 
| 173 |  |  |  |  |  |  | # responsibility alone. Under this section, the Commercial Contributor | 
| 174 |  |  |  |  |  |  | # would have to defend claims against the other Contributors related | 
| 175 |  |  |  |  |  |  | # to those performance claims and warranties, and if a court requires | 
| 176 |  |  |  |  |  |  | # any other Contributor to pay any damages as a result, the Commercial | 
| 177 |  |  |  |  |  |  | # Contributor must pay those damages. | 
| 178 |  |  |  |  |  |  | # | 
| 179 |  |  |  |  |  |  | # 5. NO WARRANTY | 
| 180 |  |  |  |  |  |  | # | 
| 181 |  |  |  |  |  |  | # EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS | 
| 182 |  |  |  |  |  |  | # PROVIDED ON AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF | 
| 183 |  |  |  |  |  |  | # ANY KIND, EITHER EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, | 
| 184 |  |  |  |  |  |  | # ANY WARRANTIES OR CONDITIONS OF TITLE, NON-INFRINGEMENT, | 
| 185 |  |  |  |  |  |  | # MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Each Recipient | 
| 186 |  |  |  |  |  |  | # is solely responsible for determining the appropriateness of using | 
| 187 |  |  |  |  |  |  | # and distributing the Program and assumes all risks associated with | 
| 188 |  |  |  |  |  |  | # its exercise of rights under this Agreement, including but not | 
| 189 |  |  |  |  |  |  | # limited to the risks and costs of program errors, compliance with | 
| 190 |  |  |  |  |  |  | # applicable laws, damage to or loss of data, programs or equipment, | 
| 191 |  |  |  |  |  |  | # and unavailability or interruption of operations. | 
| 192 |  |  |  |  |  |  | # | 
| 193 |  |  |  |  |  |  | # 6. DISCLAIMER OF LIABILITY | 
| 194 |  |  |  |  |  |  | # | 
| 195 |  |  |  |  |  |  | # EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT | 
| 196 |  |  |  |  |  |  | # NOR ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, | 
| 197 |  |  |  |  |  |  | # INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES | 
| 198 |  |  |  |  |  |  | # (INCLUDING WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON | 
| 199 |  |  |  |  |  |  | # ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR | 
| 200 |  |  |  |  |  |  | # TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF | 
| 201 |  |  |  |  |  |  | # THE USE OR DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS | 
| 202 |  |  |  |  |  |  | # GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | 
| 203 |  |  |  |  |  |  | # DAMAGES. | 
| 204 |  |  |  |  |  |  | # | 
| 205 |  |  |  |  |  |  | # 7. GENERAL | 
| 206 |  |  |  |  |  |  | # | 
| 207 |  |  |  |  |  |  | # If any provision of this Agreement is invalid or unenforceable under | 
| 208 |  |  |  |  |  |  | # applicable law, it shall not affect the validity or enforceability | 
| 209 |  |  |  |  |  |  | # of the remainder of the terms of this Agreement, and without further | 
| 210 |  |  |  |  |  |  | # action by the parties hereto, such provision shall be reformed to | 
| 211 |  |  |  |  |  |  | # the minimum extent necessary to make such provision valid and | 
| 212 |  |  |  |  |  |  | # enforceable. | 
| 213 |  |  |  |  |  |  | # | 
| 214 |  |  |  |  |  |  | # If Recipient institutes patent litigation against a Contributor with | 
| 215 |  |  |  |  |  |  | # respect to a patent applicable to software (including a cross-claim | 
| 216 |  |  |  |  |  |  | # or counterclaim in a lawsuit), then any patent licenses granted by | 
| 217 |  |  |  |  |  |  | # that Contributor to such Recipient under this Agreement shall | 
| 218 |  |  |  |  |  |  | # terminate as of the date such litigation is filed. In addition, If | 
| 219 |  |  |  |  |  |  | # Recipient institutes patent litigation against any entity (including | 
| 220 |  |  |  |  |  |  | # a cross-claim or counterclaim in a lawsuit) alleging that the | 
| 221 |  |  |  |  |  |  | # Program itself (excluding combinations of the Program with other | 
| 222 |  |  |  |  |  |  | # software or hardware) infringes such Recipient's patent(s), then | 
| 223 |  |  |  |  |  |  | # such Recipient's rights granted under Section 2(b) shall terminate | 
| 224 |  |  |  |  |  |  | # as of the date such litigation is filed. | 
| 225 |  |  |  |  |  |  | # | 
| 226 |  |  |  |  |  |  | # All Recipient's rights under this Agreement shall terminate if it | 
| 227 |  |  |  |  |  |  | # fails to comply with any of the material terms or conditions of this | 
| 228 |  |  |  |  |  |  | # Agreement and does not cure such failure in a reasonable period of | 
| 229 |  |  |  |  |  |  | # time after becoming aware of such noncompliance. If all Recipient's | 
| 230 |  |  |  |  |  |  | # rights under this Agreement terminate, Recipient agrees to cease use | 
| 231 |  |  |  |  |  |  | # and distribution of the Program as soon as reasonably practicable. | 
| 232 |  |  |  |  |  |  | # However, Recipient's obligations under this Agreement and any | 
| 233 |  |  |  |  |  |  | # licenses granted by Recipient relating to the Program shall continue | 
| 234 |  |  |  |  |  |  | # and survive. | 
| 235 |  |  |  |  |  |  | # | 
| 236 |  |  |  |  |  |  | # IBM may publish new versions (including revisions) of this Agreement | 
| 237 |  |  |  |  |  |  | # from time to time. Each new version of the Agreement will be given a | 
| 238 |  |  |  |  |  |  | # distinguishing version number. The Program (including Contributions) | 
| 239 |  |  |  |  |  |  | # may always be distributed subject to the version of the Agreement | 
| 240 |  |  |  |  |  |  | # under which it was received. In addition, after a new version of the | 
| 241 |  |  |  |  |  |  | # Agreement is published, Contributor may elect to distribute the | 
| 242 |  |  |  |  |  |  | # Program (including its Contributions) under the new version. No one | 
| 243 |  |  |  |  |  |  | # other than IBM has the right to modify this Agreement. Except as | 
| 244 |  |  |  |  |  |  | # expressly stated in Sections 2(a) and 2(b) above, Recipient receives | 
| 245 |  |  |  |  |  |  | # no rights or licenses to the intellectual property of any | 
| 246 |  |  |  |  |  |  | # Contributor under this Agreement, whether expressly, by implication, | 
| 247 |  |  |  |  |  |  | # estoppel or otherwise. All rights in the Program not expressly | 
| 248 |  |  |  |  |  |  | # granted under this Agreement are reserved. | 
| 249 |  |  |  |  |  |  | # | 
| 250 |  |  |  |  |  |  | # This Agreement is governed by the laws of the State of New York and | 
| 251 |  |  |  |  |  |  | # the intellectual property laws of the United States of America. No | 
| 252 |  |  |  |  |  |  | # party to this Agreement will bring a legal action under this | 
| 253 |  |  |  |  |  |  | # Agreement more than one year after the cause of action arose. Each | 
| 254 |  |  |  |  |  |  | # party waives its rights to a jury trial in any resulting litigation. | 
| 255 |  |  |  |  |  |  | # | 
| 256 |  |  |  |  |  |  | ############################################################################### | 
| 257 |  |  |  |  |  |  |  | 
| 258 |  |  |  |  |  |  |  | 
| 259 |  |  |  |  |  |  | # Package name | 
| 260 |  |  |  |  |  |  | package I18N::AcceptLanguage; | 
| 261 |  |  |  |  |  |  |  | 
| 262 |  |  |  |  |  |  |  | 
| 263 |  |  |  |  |  |  | # Required packages | 
| 264 | 5 |  |  | 5 |  | 293872 | use 5.006001; | 
|  | 5 |  |  |  |  | 22 |  | 
|  | 5 |  |  |  |  | 253 |  | 
| 265 | 5 |  |  | 5 |  | 30 | use strict; | 
|  | 5 |  |  |  |  | 9 |  | 
|  | 5 |  |  |  |  | 195 |  | 
| 266 | 5 |  |  | 5 |  | 34 | use warnings; | 
|  | 5 |  |  |  |  | 12 |  | 
|  | 5 |  |  |  |  | 209 |  | 
| 267 | 5 |  |  | 5 |  | 27 | use vars qw($VERSION); | 
|  | 5 |  |  |  |  | 9 |  | 
|  | 5 |  |  |  |  | 8473 |  | 
| 268 |  |  |  |  |  |  |  | 
| 269 |  |  |  |  |  |  |  | 
| 270 |  |  |  |  |  |  | # Global variables | 
| 271 |  |  |  |  |  |  | $VERSION = '1.04'; | 
| 272 |  |  |  |  |  |  |  | 
| 273 |  |  |  |  |  |  |  | 
| 274 |  |  |  |  |  |  | ############################################################################### | 
| 275 |  |  |  |  |  |  | ############################################################################### | 
| 276 |  |  |  |  |  |  | # new: class object initialization | 
| 277 |  |  |  |  |  |  | ############################################################################### | 
| 278 |  |  |  |  |  |  | ############################################################################### | 
| 279 |  |  |  |  |  |  | sub new { | 
| 280 | 6 |  |  | 6 | 1 | 55 | my $self = shift; | 
| 281 | 6 |  | 33 |  |  | 47 | my $type = ref($self) || $self; | 
| 282 | 6 |  |  |  |  | 20 | my $obj = bless {}, $type; | 
| 283 | 6 |  |  |  |  | 18 | my %arg = @_; | 
| 284 |  |  |  |  |  |  |  | 
| 285 | 6 |  | 50 |  |  | 96 | $obj->debug($arg{debug} || 0); | 
| 286 | 6 |  | 100 |  |  | 47 | $obj->defaultLanguage($arg{defaultLanguage} || ''); | 
| 287 | 6 | 100 |  |  |  | 100 | defined $arg{strict} ? $obj->strict($arg{strict}) : $obj->strict(1); | 
| 288 |  |  |  |  |  |  |  | 
| 289 | 6 |  |  |  |  | 19 | return $obj; | 
| 290 |  |  |  |  |  |  | } | 
| 291 |  |  |  |  |  |  |  | 
| 292 |  |  |  |  |  |  | ############################################################################### | 
| 293 |  |  |  |  |  |  | ############################################################################### | 
| 294 |  |  |  |  |  |  | # debug: get/set method for debug messages | 
| 295 |  |  |  |  |  |  | ############################################################################### | 
| 296 |  |  |  |  |  |  | ############################################################################### | 
| 297 |  |  |  |  |  |  | sub debug { | 
| 298 | 181 |  |  | 181 | 1 | 305 | my $acceptor = shift; | 
| 299 |  |  |  |  |  |  |  | 
| 300 | 181 | 100 |  |  |  | 390 | $acceptor->{debug} = shift if @_; | 
| 301 | 181 |  |  |  |  | 483 | return $acceptor->{debug}; | 
| 302 |  |  |  |  |  |  | } | 
| 303 |  |  |  |  |  |  |  | 
| 304 |  |  |  |  |  |  | ############################################################################### | 
| 305 |  |  |  |  |  |  | ############################################################################### | 
| 306 |  |  |  |  |  |  | # defaultLanguage: get/set method for the server default language | 
| 307 |  |  |  |  |  |  | ############################################################################### | 
| 308 |  |  |  |  |  |  | ############################################################################### | 
| 309 |  |  |  |  |  |  | sub defaultLanguage { | 
| 310 | 17 |  |  | 17 | 1 | 23 | my $acceptor = shift; | 
| 311 |  |  |  |  |  |  |  | 
| 312 | 17 | 100 |  |  |  | 50 | $acceptor->{defaultLanguage} = shift if @_; | 
| 313 | 17 |  |  |  |  | 66 | return $acceptor->{defaultLanguage}; | 
| 314 |  |  |  |  |  |  | } | 
| 315 |  |  |  |  |  |  |  | 
| 316 |  |  |  |  |  |  | ############################################################################### | 
| 317 |  |  |  |  |  |  | ############################################################################### | 
| 318 |  |  |  |  |  |  | # strict: get/set method for strict protocol conformance | 
| 319 |  |  |  |  |  |  | ############################################################################### | 
| 320 |  |  |  |  |  |  | ############################################################################### | 
| 321 |  |  |  |  |  |  | sub strict { | 
| 322 | 27 |  |  | 27 | 1 | 112 | my $acceptor = shift; | 
| 323 |  |  |  |  |  |  |  | 
| 324 | 27 | 100 |  |  |  | 59 | $acceptor->{strict} = shift if @_; | 
| 325 | 27 |  |  |  |  | 267 | return $acceptor->{strict}; | 
| 326 |  |  |  |  |  |  | } | 
| 327 |  |  |  |  |  |  |  | 
| 328 |  |  |  |  |  |  | ############################################################################### | 
| 329 |  |  |  |  |  |  | ############################################################################### | 
| 330 |  |  |  |  |  |  | # accepts: determines what the highest priority commonly known language | 
| 331 |  |  |  |  |  |  | #   between client and server is. | 
| 332 |  |  |  |  |  |  | ############################################################################### | 
| 333 |  |  |  |  |  |  | ############################################################################### | 
| 334 |  |  |  |  |  |  | sub accepts { | 
| 335 | 29 |  |  | 29 | 1 | 164 | my ($acceptor, $clientPreferences, $supportedLanguages) = @_; | 
| 336 |  |  |  |  |  |  |  | 
| 337 |  |  |  |  |  |  | # Basic sanity check | 
| 338 | 29 | 100 | 66 |  |  | 327 | if (not $clientPreferences or ref($supportedLanguages) ne 'ARRAY') { | 
| 339 | 4 |  |  |  |  | 7 | return $acceptor->defaultLanguage(); | 
| 340 |  |  |  |  |  |  | } | 
| 341 |  |  |  |  |  |  |  | 
| 342 |  |  |  |  |  |  | # There should be no whitespace anways, but a cleanliness/sanity check | 
| 343 | 25 |  |  |  |  | 59 | $clientPreferences =~ s/\s//g; | 
| 344 | 25 | 50 |  |  |  | 51 | print "Client preferences are $clientPreferences\n" if $acceptor->debug(); | 
| 345 |  |  |  |  |  |  |  | 
| 346 |  |  |  |  |  |  | # Prepare the list of client-acceptable languages | 
| 347 | 25 |  |  |  |  | 41 | my @languages = (); | 
| 348 | 25 |  |  |  |  | 83 | foreach my $tag (split(/,/, $clientPreferences)) { | 
| 349 | 40 |  |  |  |  | 154 | my ($language, $quality) = split(/\;/, $tag); | 
| 350 | 40 | 100 |  |  |  | 180 | $quality =~ s/^q=//i if $quality; | 
| 351 | 40 | 100 |  |  |  | 85 | $quality = 1 unless $quality; | 
| 352 | 40 | 50 |  |  |  | 94 | next if $quality <= 0; | 
| 353 |  |  |  |  |  |  | # We want to force the wildcard to be last | 
| 354 | 40 | 100 |  |  |  | 84 | $quality = 0 if ($language eq '*'); | 
| 355 |  |  |  |  |  |  | # Pushing lowercase language here saves processing later | 
| 356 | 40 |  |  |  |  | 207 | push(@languages, { quality => $quality, | 
| 357 |  |  |  |  |  |  | language => $language, | 
| 358 |  |  |  |  |  |  | lclanguage => lc($language) }); | 
| 359 |  |  |  |  |  |  | } | 
| 360 |  |  |  |  |  |  |  | 
| 361 |  |  |  |  |  |  | # Prepare the list of server-supported languages | 
| 362 | 25 |  |  |  |  | 50 | my %supportedLanguages = (); | 
| 363 | 25 |  |  |  |  | 35 | my %secondaryLanguages = (); | 
| 364 | 25 |  |  |  |  | 44 | foreach my $language (@$supportedLanguages) { | 
| 365 | 38 | 50 |  |  |  | 68 | print "Added language $language (lower-cased) to supported hash\n" | 
| 366 |  |  |  |  |  |  | if $acceptor->debug(); | 
| 367 | 38 |  |  |  |  | 161 | $supportedLanguages{lc($language)} = $language; | 
| 368 | 38 | 50 |  |  |  | 230 | if ($language =~ /^([^-]+)-?/) { | 
| 369 | 38 | 50 |  |  |  | 67 | print "Added language $1 (lower-cased) to secondary hash\n" | 
| 370 |  |  |  |  |  |  | if $acceptor->debug(); | 
| 371 | 38 |  |  |  |  | 131 | $secondaryLanguages{lc($1)} = $language; | 
| 372 |  |  |  |  |  |  | } | 
| 373 |  |  |  |  |  |  | } | 
| 374 |  |  |  |  |  |  |  | 
| 375 |  |  |  |  |  |  | # Reverse sort the list, making best quality at the front of the array | 
| 376 | 25 |  |  |  |  | 80 | @languages = sort { $b->{quality} <=> $a->{quality} } @languages; | 
|  | 18 |  |  |  |  | 51 |  | 
| 377 |  |  |  |  |  |  |  | 
| 378 | 25 |  |  |  |  | 31 | my $secondaryMatch = ''; | 
| 379 | 25 |  |  |  |  | 48 | foreach my $tag (@languages) { | 
| 380 | 34 | 50 |  |  |  | 67 | print "Matching ", $tag->{lclanguage}, "\n" if $acceptor->debug(); | 
| 381 | 34 | 100 | 66 |  |  | 126 | if (exists($supportedLanguages{$tag->{lclanguage}})) { | 
|  |  | 100 | 66 |  |  |  |  | 
|  |  | 100 | 33 |  |  |  |  | 
|  |  | 100 | 66 |  |  |  |  | 
|  |  | 100 | 100 |  |  |  |  | 
| 382 |  |  |  |  |  |  | # Client en-us eq server en-us | 
| 383 | 9 | 50 |  |  |  | 19 | print "Returning language ", $supportedLanguages{$tag->{language}}, "\n" | 
| 384 |  |  |  |  |  |  | if $acceptor->debug(); | 
| 385 | 9 | 100 |  |  |  | 142 | return $supportedLanguages{$tag->{language}} | 
| 386 |  |  |  |  |  |  | if exists($supportedLanguages{$tag->{language}}); | 
| 387 | 1 |  |  |  |  | 93 | return $supportedLanguages{$tag->{lclanguage}}; | 
| 388 |  |  |  |  |  |  | } elsif (exists($secondaryLanguages{$tag->{lclanguage}})) { | 
| 389 |  |  |  |  |  |  | # Client en eq server en-us | 
| 390 | 4 | 50 |  |  |  | 14 | print "Returning language ", $secondaryLanguages{$tag->{language}}, "\n" | 
| 391 |  |  |  |  |  |  | if $acceptor->debug(); | 
| 392 | 4 | 50 |  |  |  | 37 | return $secondaryLanguages{$tag->{language}} | 
| 393 |  |  |  |  |  |  | if exists($secondaryLanguages{$tag->{language}}); | 
| 394 | 0 |  |  |  |  | 0 | return $supportedLanguages{$tag->{lclanguage}}; | 
| 395 |  |  |  |  |  |  | } elsif (!($acceptor->strict()) && | 
| 396 |  |  |  |  |  |  | $tag->{lclanguage} =~ /^([^-]+)-/ && | 
| 397 |  |  |  |  |  |  | exists($secondaryLanguages{$1}) && | 
| 398 |  |  |  |  |  |  | $secondaryMatch eq '') { | 
| 399 |  |  |  |  |  |  | # Client en-gb eq server en-us | 
| 400 | 1 | 50 |  |  |  | 3 | print "Setting supported secondaryMatch of $1 for ", $tag->{lclanguage}, "\n" | 
| 401 |  |  |  |  |  |  | if $acceptor->debug(); | 
| 402 | 1 |  |  |  |  | 4 | $secondaryMatch = $secondaryLanguages{$1}; | 
| 403 |  |  |  |  |  |  | } elsif ($tag->{lclanguage} =~ /^([^-]+)-/ && | 
| 404 |  |  |  |  |  |  | exists($secondaryLanguages{$1}) && | 
| 405 |  |  |  |  |  |  | $secondaryMatch eq '') { | 
| 406 |  |  |  |  |  |  | # Client en-us eq server en | 
| 407 | 10 | 50 |  |  |  | 44 | print "Setting secondary secondaryMatch of $1 for ", $tag->{lclanguage}, "\n" | 
| 408 |  |  |  |  |  |  | if $acceptor->debug(); | 
| 409 | 10 |  |  |  |  | 26 | $secondaryMatch = $supportedLanguages{$1}; | 
| 410 |  |  |  |  |  |  | } elsif ($tag->{lclanguage} eq '*') { | 
| 411 |  |  |  |  |  |  | # * matches every language not already specified. | 
| 412 |  |  |  |  |  |  | # It doesn't care which we pick, so let's pick the default, | 
| 413 |  |  |  |  |  |  | # if available, then the first in the array. | 
| 414 | 3 | 50 |  |  |  | 9 | print "Setting default for *\n" if $acceptor->debug(); | 
| 415 | 3 | 50 |  |  |  | 8 | return $acceptor->defaultLanguage() if $acceptor->defaultLanguage(); | 
| 416 | 3 |  |  |  |  | 25 | return $supportedLanguages->[0]; | 
| 417 |  |  |  |  |  |  | } | 
| 418 |  |  |  |  |  |  | } | 
| 419 |  |  |  |  |  |  |  | 
| 420 |  |  |  |  |  |  | # No primary matches. Secondary? (ie, en-us requested and en supported) | 
| 421 | 9 | 50 |  |  |  | 21 | print "Testing for secondaryMatch\n" if $acceptor->debug(); | 
| 422 | 9 | 100 |  |  |  | 67 | return $secondaryMatch if $secondaryMatch; | 
| 423 |  |  |  |  |  |  |  | 
| 424 |  |  |  |  |  |  | # No matches. Let's return the default, if set. | 
| 425 | 4 | 50 |  |  |  | 7 | print "Returning default, if any\n" if $acceptor->debug(); | 
| 426 | 4 |  |  |  |  | 6 | return $acceptor->defaultLanguage(); | 
| 427 |  |  |  |  |  |  | } | 
| 428 |  |  |  |  |  |  |  | 
| 429 |  |  |  |  |  |  | 1; | 
| 430 |  |  |  |  |  |  |  | 
| 431 |  |  |  |  |  |  | __END__ | 
| 432 |  |  |  |  |  |  |  | 
| 433 |  |  |  |  |  |  | ############################################################################### | 
| 434 |  |  |  |  |  |  | ############################################################################### | 
| 435 |  |  |  |  |  |  | # Documentation - try 'pod2text AcceptLanguage.pm' | 
| 436 |  |  |  |  |  |  | ############################################################################### | 
| 437 |  |  |  |  |  |  | ############################################################################### | 
| 438 |  |  |  |  |  |  |  | 
| 439 |  |  |  |  |  |  | =head1 NAME | 
| 440 |  |  |  |  |  |  |  | 
| 441 |  |  |  |  |  |  | I18N::AcceptLanguage - Matches language preference to available | 
| 442 |  |  |  |  |  |  | languages | 
| 443 |  |  |  |  |  |  |  | 
| 444 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 445 |  |  |  |  |  |  |  | 
| 446 |  |  |  |  |  |  | use I18N::AcceptLanguage; | 
| 447 |  |  |  |  |  |  |  | 
| 448 |  |  |  |  |  |  | my $supportedLanguages = [( 'en-us', 'fr' )]; | 
| 449 |  |  |  |  |  |  |  | 
| 450 |  |  |  |  |  |  | my $acceptor = I18N::AcceptLanguage->new(); | 
| 451 |  |  |  |  |  |  | my $language = $acceptor->accepts($ENV{HTTP_ACCEPT_LANGUAGE}, | 
| 452 |  |  |  |  |  |  | $supportedLanguages); | 
| 453 |  |  |  |  |  |  |  | 
| 454 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 455 |  |  |  |  |  |  |  | 
| 456 |  |  |  |  |  |  | B<I18N::AcceptLanguage> matches language preference to available | 
| 457 |  |  |  |  |  |  | languages per rules defined in RFC 2616, section 14.4: HTTP/1.1 - | 
| 458 |  |  |  |  |  |  | Header Field Definitions - Accept-Language. | 
| 459 |  |  |  |  |  |  |  | 
| 460 |  |  |  |  |  |  | =head1 PUBLIC METHODS | 
| 461 |  |  |  |  |  |  |  | 
| 462 |  |  |  |  |  |  | =over 2 | 
| 463 |  |  |  |  |  |  |  | 
| 464 |  |  |  |  |  |  | =item accepts( CLIENT_PREFERENCES, SUPPORTED_LANGUAGES ) | 
| 465 |  |  |  |  |  |  |  | 
| 466 |  |  |  |  |  |  | Returns the highest priority common language between client and | 
| 467 |  |  |  |  |  |  | server. If no common language is found, the defaultLanguage is | 
| 468 |  |  |  |  |  |  | returned. If defaultLanuage is also not set, an empty string is | 
| 469 |  |  |  |  |  |  | returned. The method expects two arguments: | 
| 470 |  |  |  |  |  |  |  | 
| 471 |  |  |  |  |  |  | =over 2 | 
| 472 |  |  |  |  |  |  |  | 
| 473 |  |  |  |  |  |  | =item CLIENT_PREFERENCES | 
| 474 |  |  |  |  |  |  |  | 
| 475 |  |  |  |  |  |  | A string in the same format defined in RFC 2616, quoted here: | 
| 476 |  |  |  |  |  |  |  | 
| 477 |  |  |  |  |  |  | 1#( ( ( 1*8ALPHA *( "-" 1*8ALPHA ) ) | "*" ) [ "'" "q" "=" qvalue ] ) | 
| 478 |  |  |  |  |  |  |  | 
| 479 |  |  |  |  |  |  | Examples: | 
| 480 |  |  |  |  |  |  |  | 
| 481 |  |  |  |  |  |  | da, en-gb;q=0.8, en;q=0.7 | 
| 482 |  |  |  |  |  |  |  | 
| 483 |  |  |  |  |  |  | en-us, ja, * | 
| 484 |  |  |  |  |  |  |  | 
| 485 |  |  |  |  |  |  | =item SUPPORTED_LANGUAGES | 
| 486 |  |  |  |  |  |  |  | 
| 487 |  |  |  |  |  |  | A reference to a list of language ranges supported by the server. | 
| 488 |  |  |  |  |  |  |  | 
| 489 |  |  |  |  |  |  | =back | 
| 490 |  |  |  |  |  |  |  | 
| 491 |  |  |  |  |  |  | =item new( [ OPTIONS ] ) | 
| 492 |  |  |  |  |  |  |  | 
| 493 |  |  |  |  |  |  | Returns a new I18N::AcceptLanguage object. The method accepts the | 
| 494 |  |  |  |  |  |  | following key/value pair options: | 
| 495 |  |  |  |  |  |  |  | 
| 496 |  |  |  |  |  |  | =over 2 | 
| 497 |  |  |  |  |  |  |  | 
| 498 |  |  |  |  |  |  | =item debug | 
| 499 |  |  |  |  |  |  |  | 
| 500 |  |  |  |  |  |  | A boolean set to either 0 or 1. When set to 1, debug messages will be | 
| 501 |  |  |  |  |  |  | printed to STDOUT. The value of debug defaults to 0. | 
| 502 |  |  |  |  |  |  |  | 
| 503 |  |  |  |  |  |  | =item defaultLanguage | 
| 504 |  |  |  |  |  |  |  | 
| 505 |  |  |  |  |  |  | A string representing the server's default language choice. The value | 
| 506 |  |  |  |  |  |  | of defaultLanguage defaults to an empty string. | 
| 507 |  |  |  |  |  |  |  | 
| 508 |  |  |  |  |  |  | =item strict | 
| 509 |  |  |  |  |  |  |  | 
| 510 |  |  |  |  |  |  | A boolean set to either 0 or 1. When set to 1, the software strictly | 
| 511 |  |  |  |  |  |  | conforms to the protocol specification. When set to 0, the software | 
| 512 |  |  |  |  |  |  | will perform a secondary, aggressive language match regardless of | 
| 513 |  |  |  |  |  |  | country (ie, a client asking for only en-gb will get back en-us if the | 
| 514 |  |  |  |  |  |  | server does not accept en-gb or en but does accept en-us). The last | 
| 515 |  |  |  |  |  |  | matching language in the supported languages list will be chosen. The | 
| 516 |  |  |  |  |  |  | value of strict defaults to 1. | 
| 517 |  |  |  |  |  |  |  | 
| 518 |  |  |  |  |  |  | =back | 
| 519 |  |  |  |  |  |  |  | 
| 520 |  |  |  |  |  |  | =back | 
| 521 |  |  |  |  |  |  |  | 
| 522 |  |  |  |  |  |  | =head1 PRIVATE METHODS | 
| 523 |  |  |  |  |  |  |  | 
| 524 |  |  |  |  |  |  | =over 2 | 
| 525 |  |  |  |  |  |  |  | 
| 526 |  |  |  |  |  |  | =item debug( [ BOOLEAN ] ) | 
| 527 |  |  |  |  |  |  |  | 
| 528 |  |  |  |  |  |  | A get/set method that returns the value of debug, set by the optional | 
| 529 |  |  |  |  |  |  | method argument. | 
| 530 |  |  |  |  |  |  |  | 
| 531 |  |  |  |  |  |  | =item defaultLanguage( [ LANGUAGE ] ) | 
| 532 |  |  |  |  |  |  |  | 
| 533 |  |  |  |  |  |  | A get/set method that returns the value of defaultLanguage, set by the | 
| 534 |  |  |  |  |  |  | optional method argument. | 
| 535 |  |  |  |  |  |  |  | 
| 536 |  |  |  |  |  |  | =item strict( [ BOOLEAN ] ) | 
| 537 |  |  |  |  |  |  |  | 
| 538 |  |  |  |  |  |  | A get/set method that returns the value of strict, set by the optional | 
| 539 |  |  |  |  |  |  | method argument. | 
| 540 |  |  |  |  |  |  |  | 
| 541 |  |  |  |  |  |  | =back | 
| 542 |  |  |  |  |  |  |  | 
| 543 |  |  |  |  |  |  | =head1 NOTES | 
| 544 |  |  |  |  |  |  |  | 
| 545 |  |  |  |  |  |  | =over 2 | 
| 546 |  |  |  |  |  |  |  | 
| 547 |  |  |  |  |  |  | =item Case Sensitivity | 
| 548 |  |  |  |  |  |  |  | 
| 549 |  |  |  |  |  |  | Language matches are done in a case-insensitive manner but results are | 
| 550 |  |  |  |  |  |  | case-sensitive to the value found in the SUPPORTED_LANGUAGES list. | 
| 551 |  |  |  |  |  |  |  | 
| 552 |  |  |  |  |  |  | =back | 
| 553 |  |  |  |  |  |  |  | 
| 554 |  |  |  |  |  |  | =head1 AVAILABILITY | 
| 555 |  |  |  |  |  |  |  | 
| 556 |  |  |  |  |  |  | This module is available on CPAN worldwide and requires perl version | 
| 557 |  |  |  |  |  |  | 5.6.1 or higher be installed. | 
| 558 |  |  |  |  |  |  |  | 
| 559 |  |  |  |  |  |  | =head1 AUTHORS | 
| 560 |  |  |  |  |  |  |  | 
| 561 |  |  |  |  |  |  | Christian Gilmore <cag@us.ibm.com> | 
| 562 |  |  |  |  |  |  |  | 
| 563 |  |  |  |  |  |  | =head1 SEE ALSO | 
| 564 |  |  |  |  |  |  |  | 
| 565 |  |  |  |  |  |  | RFC 2616 | 
| 566 |  |  |  |  |  |  |  | 
| 567 |  |  |  |  |  |  | =head1 COPYRIGHT | 
| 568 |  |  |  |  |  |  |  | 
| 569 |  |  |  |  |  |  | Copyright (C) 2003, 2004 International Business Machines Corporation | 
| 570 |  |  |  |  |  |  | and others. All Rights Reserved. | 
| 571 |  |  |  |  |  |  |  | 
| 572 |  |  |  |  |  |  | This module is free software; you can redistribute it and/or | 
| 573 |  |  |  |  |  |  | modify it under the terms of the IBM Public License. | 
| 574 |  |  |  |  |  |  |  | 
| 575 |  |  |  |  |  |  | =cut |