dl10n-3.00/0000755000000000000000000000000011704574722007251 5ustar dl10n-3.00/debian/0000755000000000000000000000000011710720056010461 5ustar dl10n-3.00/debian/compat0000644000000000000000000000000211704570450011663 0ustar 8 dl10n-3.00/debian/changelog0000644000000000000000000000427211710720007012334 0ustar dl10n (3.00) unstable; urgency=low * First public release after more than 13 years of lawful services for the debian website, and two major unpublished versions. Credits should go to Martin Quinson, Nicolas François and many others who improved these script all along the years. Shame should go to /me who has always been lazy to not upload the package/ * Upgrade debhelper compatibility level to 8 * Set maintainer to team and uploader to myself * Use dh7-style debian/rules and drop everything for which I find no use (such as localization and localized manpages....while there is no gettext infrastructure in the package as of now) * Use "3.0 (native)" source format * Use ${misc:Depends} in package dependencies * Update Standards to 3.9.2 * Complete copyright and licence information in debian/copyright [modules] * Move the core perl modules to Debian::L10n Move Local::Inside to Debian::Pkg [Debian::L10n::Db.pm] - Pack headers as fields of pseudo package which name is empty (''). Still accepts the old syntax; such DB can be feeded to grep-dctrl. - no field are mandatory anymore. [dl10n-check] - rename from transmonitor-check - include the synonym file as included DATA section - search for templates only in the debian directory since the contrary leads to too much false positives. [dl10n-spider] - rename from the Tim Dijkstra & Nicolas Bertolissio l10n-bot script - convert to Debian::L10n::Db.pm - remove the documentation of the internals - add options to specify which message to begin from - accepts the french translation of the tag (used before) - replace "=over4" by "=over". That seems to make pod2man happy [dl10n-html] - replace "=over4" by "=over". That seems to make pod2man happy [dl10n-mail] - replace "=over4" by "=over". That seems to make pod2man happy [dl10n-txt] - rename from display_txt, and first public release. - properly deal with NMUs for new upstream versions (Debian revision number starting with 0): no longer identify them as native packages -- Christian Perrier Sat, 28 Jan 2012 08:13:06 +0100 dl10n-3.00/debian/control0000644000000000000000000000213611704573152012074 0ustar Source: dl10n Section: text Priority: optional Maintainer: Debian l10n development team Uploaders: Christian Perrier Standards-Version: 3.9.2 Build-Depends-Indep: debhelper (>= 8), liblocale-gettext-perl, perl-modules Package: dl10n Architecture: all Depends: perl | perl5, gettext (>= 0.11), liblocale-gettext-perl, perl-modules, libwww-perl, libmailtools-perl, libtimedate-perl, ${misc:Depends} Description: Debian infrastructure and tools for localization dl10n is the debian localization project. This package contains all the relevant infrastructure and tools. Of course, most people won't really need the server side part on their machine, but given the size of the package, there is no need for a split. . This package contains the main libraries of po4a, and the following tools: . - dl10n-check: dig into the source packages looking for stuff to translate - dl10n-bot: reads the translator mailing lists seeking for status update - dl10n-txt: generate textual statistic views - dl10n-html: generates the debian web pages dl10n-3.00/debian/source/0000755000000000000000000000000011710720017011756 5ustar dl10n-3.00/debian/source/format0000644000000000000000000000001511704572473013203 0ustar 3.0 (native) dl10n-3.00/debian/copyright0000644000000000000000000000252211710717731012423 0ustar The first prototype of a l10n statistic extractor script for Debian was made during the summer 1999 by Martin Quinson. In 2000, Denis Barbier made an almost complete rewrite to drasticaly improve performance and modularity. He maintained this service between 2000 and 2004 for the Debian translators community. In 2003 and 2004, Tim Dijkstra and Nicolas Bertolissio came out with a script to crawl the translators mailing lists and extract some status informations. In 2004, Martin Quinson packaged and integrated all those scripts. Copyright: © 1999 Martin Quinson © 2000 Denis Barbier © 2003,2004 Tim Dijkstra , Nicolas Bertolissio © 2005-2011 Christian Perrier , Nicolas François All those programs and scripts are distributed under the GPL licence version 2. Files in lib/Locale are distributed under the GPL licence version 1 or Artistic licence. On Debian GNU/Linux systems, the complete text of the GNU General Public License version 2 can be found in `/usr/share/common-licenses/GPL-2', the complete text of the GNU General Public License version 1 can be found in `/usr/share/common-licenses/GPL-1' and the complete text of the Artistic License can be found in `/usr/share/common-licenses/Artistic'. dl10n-3.00/debian/rules0000755000000000000000000000004111704572322011540 0ustar #!/usr/bin/make -f %: dh $@ dl10n-3.00/html/0000755000000000000000000000000011704570256010213 5ustar dl10n-3.00/html/score.png0000644000000000000000000001337011544665454012047 0ustar PNG  IHDRb2p% obKGD pHYs  tIME  +fWtEXtCommentXpdf: test.pdf.E/ccIDATx]1ӗ?=* 7~$ܹpTq*+tWvL 4s4HtTAHm$8;W!iٙwvv XC 4=Vad lՠ w4m۾oǮ&o"lǷC]-J{xW׫V8yK;.fSӴ&vj!IRl tf١+ fn\.(e^wG"sW,o4 0,5OǷc{7y<ӧAr[5Nϗ `ļS!I2(/CvDR=~xX;%EkeY(EӴJ|8@d Dʚ$I>yȫ}v`eYa2X,J`l60emu e1 `0Q+Ǐi@_sV8R(8qV8wq DQr`0p]q~jj /af"m ,bYn݆x6:yUU%϶jŲ,qdf:a&z۶5My~Z?;;Nt4,6YEQg>N|󪿿Zޞx<ϓ~Fr<>$yrO-,޵H(( / xJQUUvBb>t ,L#̰X,'3Q~߇GX%϶Z-lZFAQ%RX,Ԥu<-kٵ@5y.Y 欳~O0rsz.y^Q&nKFJ&,~"Bn˪ҷ )q!'ҡۘ !NC:H` .2eY^oa^OfmF}X,^+E%cf3¢4kee;NEd/a[} =%s4 Ĉ zqJi42V>h( 0OKY_c`ehߧ6bطHh3\,łv Ɩ{sZ},DA\uW_:۾6_.P-6Aw_8ClVMEr L@m[q$,Kט y$I" +IRE+ bEQR4 o˲f QѿK8e80 ǁϋ|yE4a]8; äoY4u!g ? Ɂ`O b0:$iZmN'7ynj4y'D{1 SShmp&Pd2eٶm oUCʟL&];qI x^';XVL&b^Z 5LDQ`$˲Rl6K4a/_jjWM^|I_믿ŋ~m2 x,JN~ {<_>==jbĭeٳgeٟ~O<_eY?~d2Ç-Z.^EėByun&-|ݻw:>>gGGGOfS x-1,C2Y&ї˰+t(܃ Z]? flб X?G'v1m qZYʨFgglPvo߾t:CGfp6Ǚfprٮ]Cf˹'C& V*k9/O'W4ūժiE1 eٴBaʏ9aڣK$$7H#l$Fmfs'wV,x>HPzW ˲A WB}44͛7baN0)M_ݶmHdلxʔ<Ó>w p.eY|^UK+M( [N-JRR<}}b#f @,KN3d&> :ضNsK@eYphTPhۖeu:( ST2Ԥ$It`K9yw*D .aNcͩp/Mm󜘦h4Y6e{A `#p: 0B.iضzl* >mtNfǏUU%*AUUMhuaӁHWUUgȴmZ^f乯 ( ?JNI $۔$ WWihsQ,z<6IfHJڥ-9D8C22{-v,c6I XR\ >pCkgbݝ2ELY|>e0InMF#RD#%&\6/`̭(ˉsIaj%CR.mȁ2gj:86#9nم6Q)PkÛ~RT\ %@ǖVk x^QScR6QER۽M(wzYbj2CR.m!<.0yd鐆X[tER*xE5濅aݳVM&[Nf>qI5!)ixpgieTxy2LVU\]4B+B`YvZm@@ %սæl:iDds4͌`dkdK& C]0D>T*5vȐKk3\9Dʘ)B ˜z\.?~/O>}ꕮp4w! ˊJ%875$JXS^A A II#TB$UU1T@ &NjA0 XŲ,x\]%ip{%e&j$InÑ@-KǛ0 ^@ hM0rxtDZmqJ r\jǁjȩxFCjy^T1@kPIr&q2 EQ^ 4i˲xi 7ӇX,c0@(DɁ.df6]eY&ьevW^y4%<$x0 m^.Jօy>ы-KA{4 !䡂Iy?FAmy$ISA$Y޾}K,HAE 8 rٙ}>`2C`?(NOO_~G]o˲K驦if @ /0hmޤyc1y ^.8k#-ia@*iBapeYC $aU%IB@ &@ R?C!IENDB`dl10n-3.00/html/pseudo-urls.html0000644000000000000000000001416011704570256013365 0ustar Coordination of l10n teams
Debian Project

Pseudo-urls

The program that listens to debian-l10n-french understands pseudo-urls in the subject header. The pseudo-urls have to have the following form

[<state>] <type>://<package>/<file>

The state can be one of the following: TAF, ITT, RFR, LCFC, BTS#<bug_nb> or DONE.

  • TAF (Travail À Faire)
    • Sent to indicate that there is a document that needs to be worked on
  • MAJ (Mise À Jour)
    • Sent to indicate that there is a document that needs to be updated and that the work is reserved for the previous translator
  • ITT (Intent To Translate)
    • Sent to indicate that you plan to work on the translation, used to avoid double work
  • RFR (Request For Review)
    • Initial translation is done and, attached to the mail, others on the list can then go over it to check for errors
    • Possibly followed by other RFR when substantial changes have been made
    • NOTE: send a reply if you checked it and found no flaws
  • ITR (Intent To Review)
    • Used to avoid LCFC's being sent when there are pending reviews out
    • Mainly used when you expect your review not to be ready for several days (because the translation is big, or you don't have any time before the weekend, ...)
    • mail body should contain an indication of when to expect the review
    • NOTE: Not parsed by the spider
  • LCFC (Last Chance For Comment)
    • Indicates that translation is done, change from the review process have been incorporated, and translation will be send to the appropriate place
    • Can be sent when there are no ITR's, discussion following the RFR has ended and it has been 3 days since the RFR
    • should not be sent before there has been at least one review
  • BTS#<bug number> (Bug Tracking System)
    • Used to register a bug number once you submitted the translation to the BTS
    • Regularly the spider will check if an open bug report has been fixed or closed
  • WONTFIX#<bug number> (bug marked as WONTFIX)
    • Used when a bug has been marked as wontfix
  • FIX#<bug number> (bug FIXed)
    • Used when a bug has been marked as fixed (after an NMU)
  • DONE
    • Used to close a bug once the translation has been taken into account, usefull if it has not been sent to the BTS
  • HOLD
    • Used to put a translation on hold, when the original version has changed but there is no need to update the translation, e.g. you know other modifications will be done soon on the translation and you don't want someone to update it too quickly

The type can be anything indicating the type of the document, e.g.: po-debconf, debian-installer, po, man or wml (webwml is deprecated, wml should by used instead).

package is the name of the package where the document comme from. Please use www.debian.org for the wml files of the Debian web site cvs.

file is the filename of the document, it can contain other information such as the path to the file or the section for a manpage, so no other document in the same package should be refered the same.

The structure of name depends on the chosen type. In principle it's just an identifier, but it's strongly recommended to follow the following rules.

  • po-debconf://package-name/fr.po
  • po://package-name/path-in-sourcepackage/filename.po
  • debian-installer://package-name/path-in-sourcepackage
  • wml://www.debian.org/path_under_french_in_cvs
  • man://package-name/section/subject

The state BTS is somewhat special, it used to register a bug number so the l10n-bot can track the status of you're translation once you submitted it to the BTS. Every day it will check if any of the open bug reports have been closed. An example of this command is:

[BTS#1234] po-debconf://cupsys

If you have the intent to translate a lot of packages, you can ITT them all at ones. An example:

[ITT] po-debconf://{cupsys,courier,apache}
So put the packages between curly braces and separate them with comma's. No extra spaces! 

© 2003-2004 Tim Dijkstra
© 2004 Nicolas Bertolissio
© 2004 Martin Quinson

Comments: Nicolas Bertolissio

dl10n-3.00/html/untranslated.png0000644000000000000000000000015411544665454013434 0ustar PNG  IHDRCv\3IDAT-ʱ0 @W_0 b CSSO r- y I(@%IENDB`dl10n-3.00/html/translated.png0000644000000000000000000000016211544665454013070 0ustar PNG  IHDRCv\9IDAT= 0 5wA_H>w8[RSY)bI-}'ŐdIENDB`dl10n-3.00/html/l10n.css0000644000000000000000000000210611544665454011505 0ustar h3 { font-size: 120%; padding-left: 2em; } td { padding-left: 1ex; padding-right: 1ex; } .taf { background-color: #FFDDDD; } .taf:hover { background-color: #FFBCBC; } .todo { background-color: #FFDDDD; } .todo:hover { background-color: #FFBCBC; } .maj { background-color: #FFDDDD; } .maj:hover { background-color: #FFBCBC; } .itt { background-color: #FFEEDD; } .itt:hover { background-color: #FFDDBC; } .rfr { background-color: #FFFFDD; } .rfr:hover { background-color: #FFFFBC; } .itr { background-color: #FFFFDD; } .itr:hover { background-color: #FFFFBC; } .lcfc { background-color: #DDEEFF; } .lcfc:hover { background-color: #BCDDFF; } .bts { background-color: #DDFFFF; } .bts:hover { background-color: #BCFFFF; } .wontfix { background-color: #DDFFDD; } .wontfix:hover { background-color: #BCFFBC; } .fix { background-color: #DDFFDD; } .fix:hover { background-color: #BCFFBC; } .done { background-color: #DDFFDD; } .done:hover { background-color: #BCFFBC; } .hold { background-color: #DDDDDD; } .hold:hover { background-color: #BCBCBC; } dl10n-3.00/html/fuzzy.png0000644000000000000000000000016011544665454012114 0ustar PNG  IHDRCv\7IDAT]DZ @eg> 2F3Z]"7a'׊\mG)ZIENDB`dl10n-3.00/Changelog0000644000000000000000000005527211704570256011074 0ustar 2011-08-20 Nicolas François * lib/Debian/Pkg/Tar.pm: Add support for xz compressed files. 2011-08-06 Christian Perrier * dl10n-html, lib/Debian/L10n/Html.pm, lib/Debian/L10n/Utils.pm: Enable Slovak. 2011-07-28 Nicolas François * compendia/msg2utf8: Use the Content-Type field to find the charset. isutf8 is not always installed. * compendia/msg2utf8: Use msgconv in place to convert the encoding. There is no need to mess with the Content-Type field. 2011-07-25 Nicolas François * dl10n-rrd/manpages-rrd.pl: Remove sparc, alpha, hppa. 2011-07-25 Nicolas François * dl10n-nmu: The BTS may not know the maintainer of all packages. 2011-07-25 Nicolas François * dl10n-html, lib/Debian/L10n/Html.pm, lib/Debian/L10n/Utils.pm: Enable galician. 2011-07-25 Nicolas François * compendia/l10n.conf: Remove the creation of the POTMPDIR from the config file. Just define the parent directory TMPDIR. * compendia/gen_compendia: Enable set -e but do not fail with createcompendium, provide log instead. * compendia/createcompendium: The creation of the POTMPDIR is moved here, and is removed with trap. * compendia/createcompendium: Since set -e is enabled, we need to catch the msgcat failures (and we report them back to the log and the parent gen_compendia. 2011-02-20 Nicolas François * lib/Debian/L10n/BTS.pm: Added source package to a warning. 2011-02-20 Nicolas François * dl10n-txt: When there are reports for multiple languages, provide a footer only at the end. 2011-02-19 Nicolas François * dl10n-html: Added Czech support. 2011-02-19 Nicolas François * compendia/createcompendium: Remove old compendia and log file when a compendia is successfully generated. * compendia/convert_or_remove: Really perform cleanup. * compendia/l10n.conf: Create the gen-compendia temporary file if it does not exist. 2010-09-09 Denis Barbier * lib/Debian/Pkg/Tar.pm: Fix PO extraction bug (dokuwiki) affected. 2010-06-09 Nicolas François * lib/Debian/Pkg/DebSrc.pm: Avoid duplicate report for files present in multiple archives. 2010-06-09 Nicolas François * lib/Debian/Pkg/DebSrc.pm, lib/Debian/Pkg/Tar.pm: A file can be included in multiple archives. The archives are parsed in reverse order, and once extracted files do not need to be overridden. 2010-06-09 Nicolas François * html/pseudo-urls.html: There are no bug number with the DONE pseudo-tag. 2010-04-12 Nicolas François * lib/Debian/Pkg/Diff.pm: Allow diff header to end with spaces/tabulation. This may break parsing of patches for files ending with a space or tabulation. 2010-04-12 Nicolas François * lib/Debian/L10n/BTS.pm: Do not complain if a bug is reported against a binary package and the source package is in the database. 2010-01-03 Nicolas François * lib/Debian/Pkg/Tar.pm: The leading directory should not be '.', include the next directory in that case. This fixes the handling of ocfs2-tools, but needs to be checked with the whole archive. 2010-01-03 Nicolas François * dl10n-check: Forward the --debug option to the Tar package. 2010-01-03 Nicolas François * dl10n-pts: Fixed typo, strftime needs an array, not a reference. 2010-01-02 Nicolas François * dl10n-rrd/manpages-rrd.pl: Updated list of architectures per distributions. 2010-01-01 Nicolas François * dl10n-rrd/dl10n-rrd: Do not warn when a language code is no more used. 2010-01-01 Nicolas François * dl10n-pts: Added generation date and database version * dl10n-pts: Added description of errors. 2010-01-01 Nicolas François * MANIFEST: Updated list of files. * lib/Debian/L10n/Utils.pm, lib/Debian/L10n/BTS.pm: Added minimal documentation header. * Makefile.PL: Updated list of scripts. 2009-12-29 Nicolas François * compendia/l10n.conf: Directly use the extracted files. * compendia/update_fs: There is no need anymore to cleanup the previous runs and extract the gziped PO files 2009-12-29 Nicolas François * dl10n-check: Only warn about packages already in the database if verbose is enabled (different versions do not necessarily generate a warning anymore). 2009-12-29 Nicolas François * lib/Debian/Pkg/Tar.pm: Added option prepend_dir to force prepending the directory during parse(). This is needed for the v3 source package support. * lib/Debian/Pkg/DebSrc.pm: Use this option, otherwise the files are extracted without the directory. 2009-12-29 Nicolas François * dl10n-rrd/dl10n-rrd: Do not die when the statistics are empty. It occurs for language codes that are no more used. 2009-12-29 Nicolas François * lib/Debian/Pkg/DebSrc.pm: Hack to support v3 source packages. * dl10n-check: In the v3 source packages, the debian archive is not rooted to /. 2009-12-29 Nicolas François * lib/Debian/Pkg/Tar.pm: Fixed typo (unknozn). 2009-09-10 Nicolas François * dl10n-check: Added blacklist of PO files (used in testsuites) and whitelist of po4a files. 2009-09-10 Nicolas François * lib/Locale/Language.pm: Added languages: an, ang, bem, crh, csb, frp, hne, io, kab, mai, mal, mus, nds, new, pms, tlh. * lib/Locale/Language.pm: Javanese is jv, not jw. 2009-09-10 Nicolas François * dl10n-pts: Do not hardcore a todo for shadow. * dl10n-pts: Fix mis-detection of todos. 2009-08-28 Nicolas François * dl10n-check: Removed non-US sections, and non-US handling. * dl10n-check: Updated list of sections. 2009-08-15 Nicolas François * lib/Locale/Language.pm: Added Asturian. * dl10n-check: Added support for 3 letters language * lib/Debian/L10n/Html.pm: Removed unneeded modules. * dl10n-check: Move PO files in 'doc' or 'man' directories in the po4a section. 2009-07-23 Nicolas François * dl10n-pts: Escape the '<' and '>' characters in HTML output. 2009-07-23 Nicolas François * dl10n-pts: Fixed broken links. 2009-07-23 Nicolas François * dl10n-pts: Added tests for packages with no up-to-date po-debconf translation and less than 5 po-debconf translations. 2009-07-23 Nicolas François * dl10n-pts: Only display the categories where a PO file exist. 2009-07-23 Nicolas François * dl10n-pts: Provide some help to the maintainer on how they can check the PO files and what they should do. 2009-07-23 Nicolas François * dl10n-pts: Add the generation time. * dl10n-pts: Sort the packages. 2009-07-23 Nicolas François * dl10n-pts: Differentiate between no translations (-) and no translated strings (0). 2009-07-23 Nicolas François * dl10n-pts: Added section regarding errors in translations. 2009-07-22 Nicolas François * dl10n-pts: Added boolean to indicate if a todo message should be displayed on the PTS. Only shadow currently. 2009-07-22 Nicolas François * dl10n-pts: Fixed URL. i18n is still debian.net. 2009-07-22 Nicolas François * dl10n-nmu: Some buggy bugs are sent without a subject. Just ignore them when parsing the wnpp and ftp.debian.org bugs. 2009-07-22 Nicolas François * dl10n-pts: Generate more fancy pages. 2009-07-22 Nicolas François * lib/Debian/L10n/Utils.pm: Do not recode with a broken encoding. 2009-07-22 Nicolas François * lib/Debian/Pkg/Diff.pm: Fix support for files with a spece in their name. 2009-07-22 Nicolas François * dl10n-pts, html/translated.png, html/fuzzy.png, html/untranslated.png: Added script to generate translation statistics for the PTS. 2009-04-19 Nicolas François * lib/Debian/L10n/BTS.pm (parse_submitter): Extract the submitter before encoding entities. This caused failures in Mail::Address (this was triggered by #524358) 2009-03-07 Nicolas François * lib/Debian/L10n/BTS.pm: Do not check the BTS if no bugs have to be checked. 2009-03-07 Nicolas François * dl10n-rrd/dl10n-rrd: Add support for status database with history. Do not stop on the first status line matching the package/part. 2009-03-01 Nicolas François * dl10n-html, lib/Debian/L10n/Html.pm, lib/Debian/L10n/Utils.pm: Added support for Russian. 2009-02-28 Nicolas François * dl10n-rrd/example/resize_rrd.sh: Added script to resize the rrd databases. 2009-02-21 Nicolas François * dl10n-rrd/manpages-rrd.pl: Updated list of Architecture for each suite. 2009-02-21 Nicolas François * dl10n-mail, lib/Debian/L10n/Mail.pm: Pass command line options to Mail::process. 2009-02-21 Nicolas François * lib/Debian/Pkg/Tar.pm: "Some tar files have no trailing null block". Added an argument to _io_read to avoid failing when it cannot read this bloc at the end of the archive. * lib/Debian/Pkg/Tar.pm: Added support for wrong checksums from SunOS and HP-UX tar. * lib/Debian/Pkg/Tar.pm: Do not warn for the "unable to determine top-level directory" errors. This is handled correctly later. The warning will be output in debug mode. 2009-01-15 Nicolas François * lib/Debian/L10n/BTS.pm, lib/Debian/L10n/Spider.pm: Do not overload the BTS soap interface. Prepare the list of bugs we need to check, and then check all the bugs at the same time. Thanks to Don Armstrong. check_bts_bug_soap() renamed check_bts_bugs_soap(). The function does not return any status anymore. 2008-12-06 Nicolas François * pootle/sync-projects.d/20di: Execute with "set -e". * pootle/sync-projects.d/20di: Quote variables. 2008-12-06 Nicolas François * pootle/sync-projects.d/10debconf: Execute with "set -e". * pootle/sync-projects.d/10debconf: Quote variables. * pootle/sync-projects.d/10debconf: Create the temporary directory with mktemp instead of tempfile. This avoid having to remove the file and create the directory later. * pootle/sync-projects.d/10debconf: Better handling of packages without a debian/po directory in the root. * pootle/sync-projects.d/10debconf: Ignore the errors from msgcat. (A lot of empty PO files were created with no valid charset) * pootle/sync-projects.d/10debconf: Fix typo: lang -> $lang. * pootle/sync-projects.d/10debconf: Use /srv/pootle.debian.net/tmp/ for the temporary files and directories. 2008-12-06 Nicolas François * pootle/sync-projects.d/x20ddtp: Execute with "set -e". * pootle/sync-projects.d/x20ddtp: Quote variables. * pootle/sync-projects.d/x20ddtp: Removed TEMPDIR variable (not used). * pootle/sync-projects.d/x20ddtp: Use /srv/pootle.debian.net/tmp/ for the temporary files. 2008-12-06 Nicolas François * pootle/sync-projects.d/30sync: Execute with "set -e". 2008-12-06 Nicolas François * pootle/sync-projects.d/cfg/10debconf, pootle/sync-projects.d/cfg/common: Configuration files are just sourced. They do not need to be executable and do not need a shebang. 2008-12-06 Nicolas François * dl10n-rrd/manpages-rrd.pl: Fix wrong detection of system() failures. Improve error messages. 2008-12-06 Nicolas François * lib/Debian/L10n/Spider.pm: check_bts_bug_soap() is now in the Debian::L10n::BTS module. 2008-12-06 Nicolas François * dl10n-check: First check for PO files, then check for nls directories. This fix an issue with sysstat, which has PO files in a directory named nls. 2008-12-06 Nicolas François * lib/Debian/L10n/BTS.pm: Only check the BTS if a status has the BTS tag, and no other status line follow for the pkg, type, file. This will reduce the load on the BTS and reduce the number of mails for the server admins. * lib/Debian/L10n/BTS.pm: re-indent. 2008-11-30 Nicolas François * pootle/sync-projects.d/cfg/10debconf: Fix the link to the material tarball. Explicitly point to the unstable material. 2008-11-30 Nicolas François * dl10n-rrd/example/update_unstable.sh: Fix the location of the $dist.gz material statistics file. 2008-11-30 Christian Perrier * dl10n-rrd/example/update_unstable.sh: Add missing [ ] in a if test. 2008-11-29 Nicolas François * dl10n-nmu, dl10n-rrd/example/update_unstableBTS.sh, dl10n-rrd/example/update_testing.sh, dl10n-rrd/example/update_unstable.sh, dl10n-rrd/example/config.sh, compendia/update_fs, compendia/l10n.conf, compendia/gen_compendia: Update the file locations according to the location on Churro. 2008-11-29 Nicolas François * lib/Debian/L10n/Utils.pm: Export the %Status, %Status_syn, %Type_syn, %LanguageList, and %Language hashes. 2008-11-29 Nicolas François * lib/Debian/L10n/Spider.pm, lib/Debian/L10n/Utils.pm: %Status, %Status_syn, %Type_syn, %LanguageList, %Language, parse_subject, parse_from, and parse_date moved from Spider to Utils. * lib/Debian/L10n/Spider.pm, lib/Debian/L10n/BTS.pm: parse_submitter, check_bts, check_bts_soap, and check_bts_bug_soap moved from Spider to BTS. * lib/Debian/L10n/Spider.pm, lib/Debian/L10n/Db.pm: clean_db moved from Spider to Db. * lib/Debian/L10n/Db.pm: Added support for the Message-ID header. This indicate the last imported mail and replace the year/month/message headers when Mail is used instead of Spider. * lib/Debian/L10n/Mail.pm, dl10n-mail: New tool intended to replace dl10n-spider. This tool can be used to receive mail from an mbox or from stdin (procmail filter). * lib/Debian/L10n/Utils.pm: parse_from: better handling of MIME encoded from lines. * lib/Debian/L10n/BTS.pm: check_bts_soap as I'm receiving lots of timeout from soap, add a possibility to write the database every 10 analyzed bugs. 2008-11-28 Nicolas François * dl10n-rrd/manpages-rrd.pl: No more m68k in unstable? 2008-11-27 Nicolas François * dl10n-rrd/manpages-rrd.pl: Fail in a better way if the Content files could not be downloaded. 2008-11-27 Nicolas François * dl10n-rrd/example/update_unstable.sh: Make sure the database is present and fail in a better way if not. 2008-11-27 Nicolas François * dl10n-rrd/example/config.sh: Point DL10N_HOME to SVN. Only meaningful for the default installation on Churro. 2008-10-28 Nicolas François * lib/Debian/L10n/Spider.pm, lib/Debian/L10n/Html.pm, dl10n-html: Added support for the Swedish language. 2008-10-25 Nicolas François * lib/Debian/L10n/Spider.pm: Bugs reported to wnpp do not match the database's package name. 2008-10-03 Nicolas François * dl10n-nmu: Change the page title to "Debian localization radar". 2008-09-07 Nicolas François * dl10n-txt: Add support for databases with history. 2008-09-07 Nicolas François * lib/Debian/L10n/Spider.pm: Do not fail if there is no From: field. (see http://lists.debian.org/debian-l10n-french/2008/09/msg00138.html) 2008-09-07 Nicolas François * lib/Debian/L10n/Html.pm: Add (uncomment) the anchors for translators, types, status, and packages. 2008-08-15 Nicolas François * dl10n-html: Fix typo: syntax_message -> syntax_msg. 2008-08-12 Nicolas François * lib/Debian/Pkg/DebSrc.pm: Fix typo in comment. 2008-08-11 Nicolas François * lib/Debian/L10n/Html.pm: Added support for database with history. Generate the history in the coordination pages for by_package, by_type (not for by_date, by_translator, by_status, by_bug). Compared to the previous version, the tables look more similar from one sorting method to the other. More lines are displayed (except for the by_bug pages). 2008-08-11 Nicolas François * lib/Debian/L10n/Spider.pm: Define the SOAP object global. This removes one argument from check_bts_bug_soap(). * lib/Debian/L10n/Spider.pm: check_bts_bug_soap() does not remove status lines, there is no need re-read the list of status lines. * lib/Debian/L10n/Spider.pm: Make sure $soap_bugs is defined before checking its length. * lib/Debian/L10n/Spider.pm: Added variable for the BTS location. * lib/Debian/L10n/Spider.pm (clean_db): Re-read the list of status lines for a package after each removal. * lib/Debian/L10n/Spider.pm (clean_db): Indicate the most recent statusline which can be removed for a file/type. This avoid that closure of old bugs remove the status for more recent review cycles. * lib/Debian/L10n/Spider.pm (clean_db): Log "Remove DONE" instead of "Remove bug" when a old DONE is removed. * lib/Debian/L10n/Spider.pm: Only check the BTS status if $check_bts. 2008-08-11 Nicolas François * lib/Debian/L10n/Db.pm: if a $type, $file, and $statusline are specified, remove the lines older than the specified $statusline for the given $file and $type * lib/Debian/L10n/Db.pm: del_status() always uses $statusline. Remove the specified line only if $file and $type are not defined. 2008-08-11 Nicolas François * html/l10n.css: Added support for TODO (TAF are still supported). 2008-08-11 Nicolas François * dl10n-rrd/example/update_unstableBTS.sh, dl10n-rrd/example/update_testing.sh, dl10n-rrd/example/update_unstable.sh, dl10n-rrd/example/config.sh: Updatedto match the pathes on i18n.debian.net (/org -> /srv) * dl10n-rrd/example/update_unstableBTS.sh, dl10n-rrd/example/update_testing.sh, dl10n-rrd/example/update_unstable.sh: Added Galician for graph_ranks. 2008-08-04 Nicolas François * lib/Debian/L10n/Spider.pm: Only try to cleanup the package if the package actually exists. * lib/Debian/L10n/Spider.pm: Make sure the package exists in the database before adding a status line. 2008-08-04 Nicolas François * lib/Debian/L10n/Spider.pm: Add the package name to the debug information. 2008-08-04 Nicolas François * lib/Debian/L10n/Spider.pm: When we receive a BTS status, check the status of the bug so that we can set it to DONE. This permits to clear the history later on if another review cycle is started before we notice that the bug is actually closed. 2008-08-04 Nicolas François * lib/Debian/L10n/Spider.pm: Split check_bts_soap() into check_bts_soap() and check_bts_bug_soap(). The later permits to check the status of a single bug. 2008-08-04 Nicolas François * lib/Debian/L10n/Spider.pm: After looking at the BTS, only update the database if there were some changes. Differentiate changes which require adding a status line and the one which only produce an update (date & name fixes). 2008-08-04 Nicolas François * lib/Debian/L10n/Spider.pm: There has beenno issues so far with the soap interface. Remove the support for the LDAP BTS interface. 2008-08-04 Nicolas François * lib/Debian/L10n/Spider.pm: When a new cycle starts (after a DONE), do not wait 3 days to erase the old cycle history if a new status must be added to the database. 2008-08-03 Nicolas François * lib/Debian/L10n/Html.pm, lib/Debian/L10n/Spider.pm, dl10n-html: s/portuguese_BRAZIL/brazilian/ 2008-08-03 Nicolas François * lib/Debian/L10n/Spider.pm: Keep history in the database. Use add_status(), instead of set_status(), except when a statusline is just fixed (name, date updated). 2008-08-03 Nicolas François * lib/Debian/L10n/Db.pm (del_status): Add support for clearing a specific line in the database specified by $pkg, $type, and $file. * lib/Debian/L10n/Db.pm (set_status): Add support to change the status of a specific line in the database specified by a statusline. 2008-08-03 Nicolas François * html/pseudo-urls.html: l10n.css is in html/, not ../ 2008-08-03 Nicolas François * lib/Debian/L10n/Spider.pm: Added Romanian to the list of teams. * dl10n-html: Likewise. * lib/Debian/L10n/Html.pm: Likewise. 2008-08-03 Nicolas François * lib/Debian/L10n/Spider.pm: TAF is now deprecated. Please use TODO. * lib/Debian/L10n/Spider.pm: TAF is an alias for TODO. 2008-08-03 Nicolas François * Changelog: Added Changelog file. Previous changes are documented in commits, or in debian/changelog. dl10n-3.00/dl10n-txt0000755000000000000000000003500011704570256010726 0ustar #! /usr/bin/perl -w # dl10n-stats -- Debian l10n statistics # # Copyright (C) 2004 Martin Quinson # # 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 2 of the License, or # (at your option) any later version. use strict; use Getopt::Long; #to parse the args use Time::Local 'timelocal'; # to compute bug ages my $progname= $0; $progname= $& if $progname =~ m,[^/]+$,; my $VERSION = "3.0"; #External Version Number my $BANNER = "Debian l10n infrastructure -- textual statistics extractor v$VERSION"; # Version Banner - text form my $DB_FILE="./data/status"; my $STATUS_FILE='./data/status.$lang'; my $STATUS_EN_FILE='./data/status.en'; my $IGNORE_FILE=''; my $list_file=undef; my $take_debian=0; my $fmt = "po,podebconf,po4a"; my $mask_done = 0; my $show_empty = 0; my $show_status = 0; my $show_total = 0; my $assume_bts = 0; my $diff_only = 0; use Debian::L10n::Db; sub syntax_msg { my $msg = shift; if (defined $msg) { print "$progname: $msg\n"; } else { print "$BANNER\n"; } print "Syntax: $0 [options] [lang]+ General options: -h, --help display short help text -V, --version display version and exit Package selection: --debian Only take debian specific packages --list=file Only handle the packages listed in the provided file -t,--todo Display only when the translation is NOT completed -e,--empty Display even if there is no translation to this language --diff-only Only take debian specific packages based only on the diff presence Informations to display: --total Show only summary for the lang, not each package details -s,--status Show status (hard to read when there is more than one format) --show=fmt Show only selected format (instead of $fmt) -a,--assume-bts Assume that the content bugs in the BTS were applied. Database to use: --db=DB_FILE use DB_FILE as database file (instead of $DB_FILE) --sdb=STATUS_FILE use STATUS_FILE as status file (instead of $STATUS_FILE) --edb=STATUS_EN_FILE use STATUS_EN_FILE as status file (instead of $STATUS_EN_FILE) --idb=IGNORE_FILE use IGNORE_FILE as list of packages to ignore "; if (defined $msg) { exit 1; } else { exit 0; } } # Display Version Banner # Options: -V|--version, --print-version sub banner { if ($_[0] eq 'print-version') { print "$VERSION\n"; } else { print "$BANNER\n"; } exit 0; } # Hash used to process commandline options my %opthash = (# ------------------ general options "help|h" => \&syntax_msg, "version|V" => \&banner, "print-version" => \&banner, # ------------------ configuration options "todo|t" => \$mask_done, "empty|e" => \$show_empty, "status|s" => \$show_status, "total" => \$show_total, "assume-bts|a" => \$assume_bts, "debian" => \$take_debian, "diff-only" => \$diff_only, "show=s" => \$fmt, "db=s" => \$DB_FILE, "sdb=s" => \$STATUS_FILE, "edb=s" => \$STATUS_EN_FILE, "idb=s" => \$IGNORE_FILE, "list=s" => \$list_file, ); # init commandline parser Getopt::Long::config('bundling', 'no_getopt_compat', 'no_auto_abbrev'); # process commandline options GetOptions(%opthash) or syntax_msg("error parsing options"); $show_status = 1 if ($assume_bts); #----------------------------------------------------------------------------- # The main program #----------------------------------------------------------------------------- ### ### initialisation ### (@ARGV > 0) or &syntax_msg("Nothing to do !"); my $arg; my @todo_lang; while ($arg = shift @ARGV) { push @todo_lang,$arg; } my $data = Debian::L10n::Db->new(); print "Read the database..."; $data->read($DB_FILE); print " done.\n"; my %ignored_pkgs = (); if ($IGNORE_FILE) { open IGNORE, "$IGNORE_FILE" or die "Impossible to read the ignore file $IGNORE_FILE\n"; while () { chomp; next unless $_; $ignored_pkgs{$_} = 1; } close IGNORE; } my @todo_pkg; if (defined($list_file)) { print STDERR "Get the package list from $list_file\n"; open LIST, "$list_file" || die "Impossible to read the list file $list_file\n"; while () { chomp; next unless $_; s/ //g; if ($data->has_package($_)) { push @todo_pkg, $_; # print STDERR "['$_' added]\n"; } # else { # print STDERR "['$_' is not in the DB, skipped]\n"; # } } close LIST; } else { @todo_pkg = sort $data->list_packages(); } my ($pkg,%p,%d,$man,$status); my (%total); my ($man_en_total,$man_fr_total); my %parts; map {$parts{$_} = 1} split (/,/, $fmt); my @poparts=qw(po templates podebconf po4a); my $format_top = "format STDOUT_TOP = \n". ' '.($parts{'po'}?'______________________':'').($parts{'po4a'}?'_______________________':'').($parts{'templates'}?'______________________':'').($parts{'podebconf'}?'______________________':'').($parts{'man'}?'_______':'')."\n". ' __________________|'.($parts{'po'}?'_________po__________|':'').($parts{'po4a'}?'________po4a_________|':'').($parts{'templates'}?'______templates______|':'').($parts{'podebconf'}?'_____po-debconf______|':'').($parts{'man'}?' # man |':'')."\n". '|______name________|'.($parts{'po'}?'__%__|____details____|':'').($parts{'po4a'}?'__%__|____details____|':'').($parts{'templates'}?'__%__|____details____|':'').($parts{'podebconf'}?'__%__|____details____|':'').($parts{'man'}?'_______|':'')."\n". ".\n"; # print $format_top; eval $format_top; die $@ if $@; my $format = "format STDOUT = \n"; $format .= '|@<<<<<<<<<<<<<<<< |'; foreach my $part (@poparts) { $format .= '@||| |@||||||||||||| |' if ($parts{$part}); } $format .= '@||||| |' if $parts{'man'}; $format .= "@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<\n".'$pkg, '; foreach my $part (@poparts) { $format .= '$p{\''.$part.'\'},$d{\''.$part.'\'}, ' if ($parts{$part}); } $format .= ' $man, ' if $parts{'man'}; $format .= ' $status'." ;\n.\n"; # print $format; eval $format; die $@ if $@; map { $-=0; my $lang=$_; my $statusDBname = "$STATUS_FILE"; # print STDERR "Handle $lang\n" if (scalar @todo_lang > 1); $statusDBname =~ s/\$lang/$lang/g; my $statusDB = Debian::L10n::Db->new(); $statusDB->read($statusDBname,0) if $show_status; my $statusEnDBname = "$STATUS_EN_FILE"; # print STDERR "Handle $lang\n" if (scalar @todo_lang > 1); my $statusEnDB = Debian::L10n::Db->new(); $statusEnDB->read($statusEnDBname,0) if $show_status; print "Status of the ".($take_debian?"debian ":"")."packages ".($mask_done?"to do ":"")."in $lang\n\n" unless $show_total; my %total; foreach (@todo_pkg) { $pkg = $_; # print STDERR "consider $pkg\n"; # Take only packages having material and not ignored next if defined $ignored_pkgs{$pkg}; next unless $data->has_po($pkg) || $data->has_templates($pkg) || $data->has_podebconf($pkg) || $data->has_man($pkg) || $data->has_po4a($pkg) || $show_empty; # Take only debian packages if ($take_debian) { next if ($data->has_upstream($pkg) && $data->upstream($pkg) ne "debian"); next unless ($data->has_version($pkg)); next if ($data->version($pkg) =~ m/-\d/ and not $diff_only); } # Take only packages having material in this language (unless --empty) my $found=0; $man=' '; my (%score,%ori,%extra); $status=''; foreach my $part (@poparts) { my $has_part="has_$part"; $p{$part}=''; $d{$part}=''; if ($parts{$part} && $data->$has_part($pkg)) { my $bts_reported=0; $status .= "$part("; $score{$part} = '---'; if ($show_status && $statusDB->has_package($pkg) && $statusDB->has_status($pkg)) { my $tmpstatus; foreach my $statusline (@{$statusDB->status($pkg)}) { my ($kind,$file,$date,$status_from_db,$translator,$url,$bug_nb) = @{$statusline}; # FIXME sort on file? (e.g. dpkg has different # files) if ($kind eq $part) { my $days = "??"; if ($date =~ m/^(\d{4})-(\d\d)-(\d\d) (\d*):(\d*):(\d*)/) { # 2003-07-26 $days = sprintf "%.0f", (time - timelocal ($6,$5,$4,$3,$2-1,$1)) / (60 * 60 * 24); } $tmpstatus = "$status_from_db, $days days "; if ($status_from_db =~ m/^(bts|done|hold|fix|wontfix)$/i) { $bts_reported = 1; } else { $bts_reported = 0; } } } # Only keep the last status. $status .= $tmpstatus if defined $tmpstatus; } elsif ($show_status && $statusEnDB->has_package($pkg) && $statusEnDB->has_status($pkg)) { foreach my $statusline (@{$statusEnDB->status($pkg)}) { my ($kind,$file,$date,$status_from_db,$translator,$url,$foo,$bug_nb) = @{$statusline}; if (($part eq "podebconf") and ($kind eq "templates")) { my $days = "??"; if ($date =~ m/^(\d{4})-(\d\d)-(\d\d) (\d*):(\d*):(\d*)/) { $days = sprintf "%.0f", (time - timelocal ($6,$5,$4,$3,$2-1,$1)) / (60 * 60 * 24); } $status .= "rev, $days days"; } } } $status .= ') '; $status =~ s/ \)/)/; $status =~ s/$part\(\)//; foreach my $line (@{$data->$part($pkg)}){ my ($pofile, $langfound, $stat) = @{$line}; if ($langfound eq $lang) { $score{$part} = add_stat($stat,$score{$part}); if ($mask_done) { unless ( ($assume_bts && $bts_reported) or (output_percent($stat) eq '100%')) { $found = 1; } } else { $found = 1; } } elsif ($langfound eq '_') { $ori{$part} = add_stat($stat, $ori{$part}); } elsif ($langfound ne '') { $extra{$part} = $stat; } } if ($score{$part} eq '---' && defined($ori{$part})) { $score{$part} = normalize_score($ori{$part},"0t0f0u"); $found = 1 if $show_empty && !($assume_bts && $bts_reported); } elsif (defined($ori{$part})) { $score{$part} = normalize_score($ori{$part},$score{$part}); $found = 1 if ((not $score{$part} =~ /0f0u/) && !($assume_bts && $bts_reported)); } elsif(not defined($ori{$part}) and $score{$part} eq '---' and defined $extra{$part}) { $score{$part} = "---"; $found = 1 if $show_empty && !($assume_bts && $bts_reported); } # print STDERR "show_empty=$show_empty; assume_bts=$assume_bts; bts_reported=$bts_reported; found=$found\n"; if ($score{$part} =~ /([0-9]*)t([0-9]*)f-([0-9]*)u/) { $score{$part} = '---'; $d{$part}=output_details($score{$part}); next; } $p{$part}=output_percent($score{$part}); $d{$part}=output_details($score{$part}); if (defined $score{$part} && $score{$part} ne '---') { if ($assume_bts) { my $stat_to_add=$score{$part}; if ($bts_reported) { $stat_to_add =~ /([0-9]*)t([0-9]*)f([0-9]*)u/; $stat_to_add = ($1+$2+$3)."t0f0u"; } $total{$part} = add_stat($stat_to_add,$total{$part}); } else { $total{$part} = add_stat($score{$part},$total{$part}); } } } } # Search for mans if ($parts{'man'} && $data->has_man($pkg)) { my $en=0; my $fr=0; foreach my $line (@{$data->man($pkg)}){ my ($name, $langfound) = @{$line}; $en++ if ($langfound eq 'english'); $fr++ if ($langfound eq 'french'); } $man="$fr/$en"; $man_fr_total += $fr; $man_en_total += $en; $found = 1 unless $mask_done && $fr == $en ; } write if ($found && !$show_total); } if ($show_total) { print "$lang: "; foreach my $part (@poparts) { print "$part(" .output_percent($total{$part}).";" .output_details($total{$part}).") " if ($parts{$part}); } print "\n"; } else { print "|__________________|"; foreach my $part (@poparts) { print "_____|_______________|" if $parts{$part}; } print "_______|" if $parts{'man'}; print "\n"; $pkg = "TOTAL ($lang)"; foreach my $part (@poparts) { $p{$part}=output_percent($total{$part}); $d{$part}=output_details($total{$part}); } $man="$man_fr_total/$man_en_total" if $parts{'man'}; if ($assume_bts) { $status = " Assuming that all bugs reported were applied"; } else { $status = ""; } write; print "|__________________|"; foreach my $part (@poparts) { print "_____|_______________|" if $parts{$part}; } print "_______|" if $parts{'man'}; print "\n\n\n"; } } @todo_lang; if (not $show_total) { print "When there is some ---, that means that the material exists, but is not \n". "translated to this language and that some issue (in pot file or DB) prevent to find the amount of string.\n\n"; print "Significance of the 'details' columns:\n". " [# translated strings]/[# fuzzy translation]/[# untranslated strings]\n\n"; if ($parts{'man'}) { print "Significance of the 'man' column: [# french pages]/[# english pages]\n"; print "WARNING: 'french' is hardcoded in that script for now.\n"; print "WARNING: do not trust the stats about man for now.\n"; } } sub add_stat { my $new=shift; my $old=shift; return $new unless ($old); return $new if ($old eq '---'); $new =~ /([0-9]*)t([0-9]*)f([0-9]*)u/; my ($nt,$nf,$nu) = ($1||0, $2||0, $3||0); $old =~ /([0-9]*)t([0-9]*)f([0-9]*)u/; my ($ot,$of,$ou) = ($1||0, $2||0, $3||0); my $res= ($nt+$ot)."t".($nf+$of)."f".($nu+$ou)."u"; return $res; } sub normalize_score { my $orig=shift; my $trans=shift; $orig =~ /([0-9]*)t([0-9]*)f([0-9]*)u/; my ($ot,$of,$ou) = ($1||0, $2||0, $3||0); $trans =~ /([0-9]*)t([0-9]*)f([0-9]*)u/; my ($tt,$tf,$tu) = ($1||0, $2||0, $3||0); my $res= ($tt)."t".($tf)."f".($ot+$of+$ou-$tf-$tt)."u"; return $res; } sub output_percent { my $stats=shift||""; my $t = "0"; my $u = "0"; my $f = "0"; my $percent; if ($stats =~ /([0-9]*)t/) { $t=$1; } if ($stats =~ /([0-9]*)u/) { $u=$1; } if ($stats =~ /([0-9]*)f/) { $f=$1; } $percent = calc_percent($t,$t+$u+$f); if ($percent eq "NaN" || $percent == 0) { return ''; } return "$percent\%"; } sub output_details { my $stats = shift||""; my $t = "0"; my $u = "0"; my $f = "0"; my $percent; if ($stats =~ /([0-9]*)t/) { $t=$1; } if ($stats =~ /([0-9]*)u/) { $u=$1; } if ($stats =~ /([0-9]*)f/) { $f=$1; } return ($t+$f+$u == 0 ? $stats : "$t/$f/$u"); } sub calc_percent{ my $up=shift; my $down=shift; my $res; if ($down==0) { return "NaN"; } $res = $up/$down*100; $res =~ s/^([0-9]*)\..*/$1/; return $res; } dl10n-3.00/Makefile.PL0000644000000000000000000000141711544665464011234 0ustar use 5.006; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'dl10n', 'VERSION_FROM' => 'lib/Debian/L10n/Db.pm', # finds $VERSION 'PREREQ_PM' => {'Locale::gettext' => '1.01'}, # e.g., Module::Name => 1.1 'EXE_FILES' => ['dl10n-check', 'dl10n-html', 'dl10n-mail', 'dl10n-nmu', 'dl10n-pts', 'dl10n-spider', 'dl10n-txt'], 'PMLIBDIRS' => ['lib/Debian/L10n'], ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT => 'Infrastructure for the debian localisation', AUTHOR => 'Martin Quinson \n'. 'Denis Barbier ') : ()), ); dl10n-3.00/pootle/0000755000000000000000000000000011544665447010562 5ustar dl10n-3.00/pootle/sync-projects.d/0000755000000000000000000000000011704570256013576 5ustar dl10n-3.00/pootle/sync-projects.d/30fusionforge0000755000000000000000000000017711544665453016230 0ustar #!/bin/sh . `dirname "$0"`/cfg/common #. `dirname "$0"`/cfg/`basename "$0"` cd $POOTLEDIR cd fusionforge bzr update -q 2>&1 dl10n-3.00/pootle/sync-projects.d/10debconf0000755000000000000000000001507711704570256015277 0ustar #!/bin/sh # Removed -x to avoid 45MiB emails (20110328, faw) . `dirname $0`/cfg/common . `dirname $0`/cfg/`basename $0` ##echo "`basename $0`: Updating debconf translations..." TMPDIR=/srv/pootle.debian.net/tmp export TMPDIR TEMPDIR=`mktemp -d -p "$TMPDIR" sync.XXXXXX` cd "$POOTLEDEBCONFDIR" svn -q up [ -f "$TARBALL" ] || exit 1 # First we extract the tarball in the temporary directory ##echo " Extracting files from $TARBALL..." cd "$TEMPDIR" umask 002 tar xfz "$TARBALL" mv po/unstable/* . rm -rf po # Then we extract the PO Files ##echo " Uncompress/update/check extracted files..." for pkg in `find . -mindepth 3 -maxdepth 3 -type d` ; do # Files are originally in debian/po. Move them in the root # of the directory if [ ! -d "$pkg/debian/po/" ]; then continue fi mv "$pkg"/debian/po/*gz "$pkg" 2>/dev/null # And clean out the remaining stuff rm -rf "$pkg/debian" 2>/dev/null # Uncompress files if [ `\ls -1 "$pkg"/*gz 2>/dev/null | wc -l` != "0" ] ; then gzip -d "$pkg"/*gz fi # Now we should rename those files to $LANGUAGE.po # We need to strip out the package name and version # The name of the templates.pot file will give it to us for pot in `\ls -1 "$pkg"/*templates.pot 2>/dev/null`; do root=`basename "$pot" templates.pot` for pots in `\ls -1 "$pkg"/*.pot 2>/dev/null`; do # Rename the file to "templates.pot" mv "$pots" $pkg/`basename $pots | sed "s/$root//g"` done for po in `\ls -1 "$pkg"/*.po 2>/dev/null`; do # Convert the file to UTF-8 and rename it by # stripping out the package name and version # If something fails, report if msgconv --to-code=utf-8 "$po" >$pkg/`basename "$po" | sed "s/$root//g"` 2>/dev/null; then rm "$po" else rm $pkg/`basename "$po" | sed "s/$root//g"` >/dev/null 2>&1 || true rm "$po" echo " Error while working on $po" fi done done # Now we have a directory with only $LANGUAGE.po and templates.pot TEMPFILE=`tempfile --directory "$TMPDIR"` # Now we update the file in Pootle # We need to merge the file from the tarball with # the file in Pootle (that one could have been changed by a translator # # Of course, if the directory does not exist in Pootle (new # package with debconf), we will just add it # and copy files from the tarball if [ -d "$POOTLEDEBCONFDIR/$pkg" ] ; then # So, there's something in Pootle # Cycle over all PO files for pofile in `\ls -1 "$pkg"/*.po 2>/dev/null` ; do filename=`basename "$pofile"` if [ -f "$POOTLEDEBCONFDIR/$pkg/$filename" ] ; then # Give priority to the file in Pootle # Ignore errors (e.g. wrong CHARSET because the file is empty) msgcat --use-first "$POOTLEDEBCONFDIR/$pkg/$filename" "$pofile" >"$TEMPFILE" 2>/dev/null || true # And merge with the POT file from the tarball msgmerge -U "$TEMPFILE" "$POOTLEDEBCONFDIR/$pkg/templates.pot" >/dev/null 2>&1 # And overwrite the Pootle file cp "$TEMPFILE" "$POOTLEDEBCONFDIR/$pkg/$filename" else # Maybe *that* file didn't exist in Pootle # In such case, just copy it cp "$pofile" "$POOTLEDEBCONFDIR/$pkg" msgmerge -U "$POOTLEDEBCONFDIR/$pkg/$filename" "$POOTLEDEBCONFDIR/$pkg/templates.pot" >/dev/null 2>&1 fi done else # There was no directory in Pootle yet, just copy mkdir -p "$POOTLEDEBCONFDIR/$pkg" cp -r "$pkg"/* "$POOTLEDEBCONFDIR/$pkg" fi rm "$TEMPFILE" 2>/dev/null || true done # Now we have the Pootle directory updated with files from the tarball # Let's do some cleaning' # When there are known broken files, let's clean them ##echo " Cleaning out broken files..." for file in $BROKEN; do ## echo " $file" rm "$POOTLEDEBCONFDIR/$file" done # Some packages should be ignored for various reasons ##echo " Cleaning out ignored packages..." for pkg in $IGNORE; do ## echo " $pkg" rm -rf `find "$POOTLEDEBCONFDIR" -mindepth 3 -maxdepth 3 -name "$pkg"` #2>/dev/null done # And some packages provide useless garbage ##echo " Cleaning out garbage..." for dir in $GARBAGE; do ## echo " $dir" rm -rf "$POOTLEDEBCONFDIR/$dir" done # What languages are present? LANGUAGES=`find "$POOTLEDEBCONFDIR" -name \*.po | cut -f9 -d\/ | sort | uniq | cut -f1 -d\.` # This will allow automatically adding a language as soon as *one* package # provides a file for it # Now we fill in all packages directories with one file per language # That's slightly suboptimal but this is the only way to have correct # statistics in Pootle ##echo " Updating Pootle files..." for pkg in `find "$POOTLEDEBCONFDIR" -maxdepth 3 -mindepth 3 -type d | grep -v \\.svn` ; do for lang in $LANGUAGES; do if [ ! -f "$pkg/$lang.po" ] ; then cp "$pkg/templates.pot" "$pkg/$lang.po" else msgmerge -U "$pkg/$lang.po" "$pkg/templates.pot" >/dev/null 2>&1 fi done done # Now commit the whole stuff to SVN ##echo " Committing to SVN..." cd "$POOTLEDEBCONFDIR" svn -q up # echo " Committing updated files" svn -q commit -m"[SILENT_COMMIT] Update existing files for `date +%Y%m%d%H%M`" # find . -type d | grep -v \\.svn | xargs svn add -N 2>/dev/null # echo " Adding new directories" # find . -type d | grep -v \\.svn | xargs svn add -N 2>/dev/null # echo " Adding PO files" # find . -type f -name \*.po | grep -v \\.svn | xargs svn add 2>/dev/null # echo " Adding POT files" # find . -type f -name templates.pot | grep -v \\.svn | xargs svn add 2>/dev/null # Now we need to find out what directories are in $POOTLEDEBCONFDIR but # aren't anymore in the tarball. Most of the time, this will be # packages that dropped po-debconf support ##echo " Finding added/removed files/directories..." cd "$POOTLEDEBCONFDIR" find . -mindepth 3 -maxdepth 3 -type d | grep -v \\.svn | sort > "$TMPDIR/list-pootle" cd "$TEMPDIR" find . -mindepth 3 -maxdepth 3 -type d | sort > "$TMPDIR/list-tarball" # We display the diff. It will be up to a human to delete/add # the relevant dirs in SVN (too dangerous) diff -d -I "lintian" -I "powertweak" "$TMPDIR/list-tarball" "$TMPDIR/list-pootle" > "$TMPDIR/diff" || true if [ -n "`cat $TMPDIR/diff`" ] ; then cd "$POOTLEDEBCONFDIR" echo " SVN commands to issue:" for i in `grep -E "^>" "$TMPDIR/diff" | cut -f2 -d" "` ; do svn rm --force $i svn commit -m"Removed $i after syncing with unstable packages" $i done fi # Fix permissions: g+w on everything so that (for instance) # members of the pootle group may commit, including the pootle user cd "$POOTLEDEBCONFDIR" find . -print0 | xargs --null chmod g+w 2>/dev/null # Cleaning out #Temporarily disabled to solve out a few issues rm "$TMPDIR/list-tarball" "$TMPDIR/list-pootle" >/dev/null 2>&1 || true rm -rf "$TEMPDIR" >/dev/null 2>&1 || true dl10n-3.00/pootle/sync-projects.d/99refresh-pootle0000755000000000000000000000017711544665453016657 0ustar #!/bin/sh set -e ## echo "Refreshing Pootle stats..." cd /var/tmp sudo -H -u pootle /usr/sbin/PootleServer --refreshstats dl10n-3.00/pootle/sync-projects.d/40iso-codes0000755000000000000000000000044411544665453015565 0ustar #!/bin/sh -x . `dirname "$0"`/cfg/common . `dirname "$0"`/cfg/`basename "$0"` cd $ISOCODES git fetch git pull 2>&1 | grep -v "up-to-date" git rebase origin/master 2>&1 | \ grep -v "up to date" ##echo "Updating file permissions..." find "$ISOCODES" | xargs chmod g+w >/dev/null 2>&1 dl10n-3.00/pootle/sync-projects.d/cfg/0000755000000000000000000000000011544665451014341 5ustar dl10n-3.00/pootle/sync-projects.d/cfg/10debconf0000644000000000000000000000112011544665451016017 0ustar # Packages that are false positives: they don't really have po-debconf # translations IGNORE="lintian powertweak" # Directories that contain PO files that are not relevant to debconf # translations GARBAGE="\ contrib/o/openttd/os \ main/c/clamav-getfiles/clamav-data.template \ main/f/freepops/buildfactory \ main/h/heimdal/packages \ main/i/ifupdown/_darcs \ main/n/nut/packaging \ main/r/root-system/build" # tarball location TARBALL=/srv/i18n.debian.net/www/debian-l10n-material/po-debconf-unstable.tar.gz # Directory for Pootle debconf stuff POOTLEDEBCONFDIR=$POOTLEDIR/debconf dl10n-3.00/pootle/sync-projects.d/cfg/common0000644000000000000000000000010711544665451015552 0ustar # The location of Pootle files POOTLEDIR=/srv/pootle.debian.net/pootle dl10n-3.00/pootle/sync-projects.d/cfg/40iso-codes0000644000000000000000000000010611544665451016312 0ustar # The directory holding all D-I files ISOCODES=${POOTLEDIR}/iso-codes dl10n-3.00/pootle/sync-projects.d/cfg/20di0000644000000000000000000000007111544665451015020 0ustar # The directory holding all D-I files DI=${POOTLEDIR}/di dl10n-3.00/pootle/sync-projects.d/cfg/40tasksel0000644000000000000000000000010311544665451016070 0ustar # The directory holding all D-I files TASKSEL=${POOTLEDIR}/tasksel dl10n-3.00/pootle/sync-projects.d/20di0000755000000000000000000000066211544665453014274 0ustar #!/bin/sh . `dirname "$0"`/cfg/common . `dirname "$0"`/cfg/`basename "$0"` ## echo "`basename $0`: Updating Debian Installer translations..." cd $DI svn -q up if svn st 2>&1 | grep -q -E "^C"; then echo "There is an SVN conflict in $i" fi # Fix permissions: g+w on everything so that (for instance) # members of the pootle group may commit, including the pootle user find . -print0 | xargs --null chmod g+w 2>/dev/null || true dl10n-3.00/pootle/sync-projects.d/40tasksel0000755000000000000000000000044211544665453015344 0ustar #!/bin/sh -x . `dirname "$0"`/cfg/common . `dirname "$0"`/cfg/`basename "$0"` cd $TASKSEL git fetch git pull 2>&1 | grep -v "up-to-date" git rebase origin/master 2>&1 | \ grep -v "up to date" ##echo "Updating file permissions..." find "$TASKSEL" | xargs chmod g+w >/dev/null 2>&1 dl10n-3.00/pootle/sync-projects.d/x20ddtp0000755000000000000000000000230111544665453015013 0ustar #!/bin/sh set -e echo "Updating DDTP translations:" PROJECTDIR=/srv/pootle.debian.net/pootle/ddtp DDTPPODIR=/org/ddtp.debian.net/pos echo " Sync files from the DDTP PO directories" cd "$DDTPPODIR" LANGS=`find . -maxdepth 1 -mindepth 1 -type d | sed 's/\.\///g'` TEMPFILE=`tempfile --directory /srv/pootle.debian.net/tmp/` for lang in $LANGS; do echo " $lang" cd "$DDTPPODIR/$lang/sid" for srcpkg in `find . -mindepth 2 -maxdepth 2 -type d` ; do echo " $srcpkg" for pofile in `ls -1 "$srcpkg"/*.po`; do pkg=`basename "$pofile" .po` echo " $pkg" if [ -d "$PROJECTDIR/$srcpkg/$pkg" ] ; then if [ -f "$PROJECTDIR/$srcpkg/$pkg/$lang.po" ] ; then msgcat --use-first "$PROJECTDIR/$srcpkg/$pkg/$lang.po" "$pofile" >"$TEMPFILE" 2>/dev/null cp "$TEMPFILE" "$PROJECTDIR/$srcpkg/$pkg/$lang.po" else cp "$pofile" "$PROJECTDIR/$srcpkg/$pkg/$lang.po" fi else mkdir -p "$PROJECTDIR/$srcpkg/$pkg" cp -r "$pofile" "$PROJECTDIR/$srcpkg/$pkg/$lang.po" fi done done done echo " Cleaning out broken files" rm -rf "$PROJECTDIR/d/doc-linux-html-pt" rm -rf "$PROJECTDIR/d/doc-linux-text-pt" rm -rf "$PROJECTDIR/i/itcl3" rm "$TEMPFILE" 2>/dev/null || true dl10n-3.00/compendia/0000755000000000000000000000000011704570256011206 5ustar dl10n-3.00/compendia/createcompendium0000755000000000000000000000237711704570256014471 0ustar #!/bin/bash set -e # To guarantee that files may be written by the group umask 002 GENCOMPENDIUMPATH=${GENCOMPENDIUMPATH='.'} . "$GENCOMPENDIUMPATH"/l10n.conf #create a local tmp directory POTMPDIR=`mktemp -d "$TMPDIR"/cpd.XXXXXXXXXX` # cleanup local tmp directory on exit trap 'rm -rf "$POTMPDIR"' 0 [ $# = 1 ] && MSGLANG=$1 || exit 1 find "$SITEDIR" -name "*_${MSGLANG}.po.gz" -exec cp {} "$POTMPDIR" \; gunzip "$POTMPDIR"/* RESULTS="$RESULTS/$MSGLANG" mkdir -p "$RESULTS" exec &>"$RESULTS/$STAMP.log" # for some odd reason convert_or_remove needs to be an external file # maybe because find doesn't have it defined in its environment find "$POTMPDIR" -name *.po -exec ./convert_or_remove {} \; msgcat -o "$RESULTS/compendium-$MSGLANG-stamp$STAMP.po" $POTMPDIR/*.po || { echo "EEE: failed to generate $RESULTS/compendium-$MSGLANG-stamp$STAMP.po" exit 1 } echo "III: generated $RESULTS/compendium-$MSGLANG-stamp$STAMP.po" # In order to be useful, the latest compendium needs to be used by users ln -sf "$RESULTS/compendium-$MSGLANG-stamp$STAMP.po" "$RESULTS/compendium-$MSGLANG-LATEST.po" # Remove old compendia and log files if we were successful find "$RESULTS" -name "2*.log" -a -mtime "+1" -delete find "$RESULTS" -name "compendium-*.po" -a -mtime "+1" -delete dl10n-3.00/compendia/README0000644000000000000000000000021111544665447012071 0ustar This code generates the compendia published at http://i18n.debian.net/compendia/ For more information see http://i18n.debian.net/wiki/ dl10n-3.00/compendia/msg2utf80000755000000000000000000000054311704570256012615 0ustar #!/bin/sh #set -x set -e help () { echo "$0 accepts only one parameter" } [ $# = 1 ] || help notutf8 () { grep -m 1 "Content-Type: .*; charset=.*\n" "$1" | grep -qi "utf-8" && return 1 || return 0 } if notutf8 "$1" then echo "W: $1: was not UTF-8 encoded" msgconv -t utf-8 -o "$1" "$1" else echo "I: $1: already UTF-8 encoded" fi dl10n-3.00/compendia/gen_compendia0000755000000000000000000000046611704570256013732 0ustar #!/bin/bash set -e export GENCOMPENDIUMPATH="/srv/dl10n-stuff/svn/dl10n/compendia" cd "$GENCOMPENDIUMPATH" . "$GENCOMPENDIUMPATH"/l10n.conf for LL in $COMPENDIUM_LANGS ; do "$GENCOMPENDIUMPATH"/createcompendium $LL || { # This should not happen echo "createcompendium failed for language $LL" } done dl10n-3.00/compendia/LINGUAS0000644000000000000000000000026411544665447012246 0ustar ar be bg bn bs ca cs da de dz el eo es et eu fi fr gl gu he hi hr hu id it ja ka km ko ku lt lv mk ml nb ne nl nn pa pl pt pt_BR ro ru sk sl sq sv ta th tl tr uk vi wo zh_CN zh_TW dl10n-3.00/compendia/msglib.sh0000644000000000000000000000020311544665447013023 0ustar imsg () { echo "I: $*" } emsg () { echo "E: $*" } wmsg () { echo "W: $*" } emsgx () { RET=$1 && shift emsg $* exit $RET } dl10n-3.00/compendia/charset-tests0000755000000000000000000000023411544665447013735 0ustar #!/bin/sh -e for PO in $* do echo "Stats for ${PO}:" && msgfmt --statistics -o /dev/null "${PO}" || exit $? msgcat -o /dev/null "${PO}" || exit $? done dl10n-3.00/compendia/convert_or_remove0000755000000000000000000000055511544665447014707 0ustar #!/bin/sh # converts a po file to utf-8 or removes it # also it validates the file or removes it if ./msg2utf8 "$1" then if ./charset-tests "$1" >/dev/null 2>&1 then echo "I: $1: is included in compendium" else echo "E: $1: file failed the tests, removed" rm -f "$1" "$1.utf" fi else echo "E: $1: file removed from compilation" rm -f "$1" "$1.utf" fi dl10n-3.00/compendia/l10n.conf0000755000000000000000000000125211704570256012632 0ustar #!/bin/bash #po stuff: export POSITEDIR=/srv/i18n.debian.net/www/debian-l10n-material/po/unstable/ #po-debconf stuff export PODEBCONFTGZ='/srv/i18n.debian.net/www/debian-l10n-material/po-debconf-unstable.tar.gz' export SITEDIR=/srv/i18n.debian.net/www/debian-l10n-material/po/unstable export TMPDIR=/srv/i18n.debian.net/tmp/gen-compendia/ [ -d "$TMPDIR" ] || mkdir "$TMPDIR" export RESULTS="/srv/i18n.debian.net/www/debian-l10n-compendia/po/" export STAMP=`date +%Y%m%d` export COMPENDIUM_LANGS="ar be bg bn bs ca cs da de dz el eo es et eu fi fr gl gu he hi hr hu id it ja ka km ko ku lt lv mk ml nb ne nl nn pa pl pt pt_BR ro ru sk sl sq sv ta th tl tr uk vi wo zh_CN zh_TW" dl10n-3.00/README0000644000000000000000000001322211544665464010137 0ustar This is dl10n, the Debian Localization Infrastructure. ******* * WHY * ******* No matter you call it Free Software, Open Source or whatever else, giving access to softwares and their source code to everybody is a great idea. But the licensing is not the only restriction to the openness of software: Non-translated free softwares are free only for the English speakers. Quite a lot of people on the earth just don't speak enough English to use an English speaking computer. And even if they could, non native speakers will certainly prefer to use a computer speaking their mother tongue if possible. The two main tasks to translate a computer program are (simplifying a bit) first to prepare the program to be translated (called "internationalization" or i18n), and then to actually translate it ("localization" or l10n). The i18n asks to adapt the source code of the program, and may be very very difficult. Once it's done, l10n is a rather simple task consisting in translating some chunk of text in a specialized file. The localization chalanges are thus not really technical. The first one comes from the constant evolution of free softwares. The texts to translate are endlessly modified and you have to detect those changes and let the translators adapt their work accordingly. Another difficulty comes from the diversity of actors involved in the picture and their different goals and abilities. You first have the developers, which are good in programation, but may or not care about translation issues. Then, you have the translators, which are (hopefully) good in their own language, but may not be fluent in english. Moreover, their technical abilities can be limited. And finaly, the users may be bad in technic and not speak english at all. Some stats (only valid today, 27 mai 2004) to make clearer the size of the translation teams, and the need of a specific infrastructure. #languages 100% >90% >50% #strings Debian installer 44 28 33 37 1160 Debian configurator (2d stage) 37 5 19 21 896 Debian core package (3d stage) 32 1 11 17 2190 Debian package scripts 51 0 0 3 7804 KDE 3.1 75 5 17 40 44105 KDE 3.2 77 7 20 37 61227 Koffice 1.3 73 7 15 35 8679 KDE 3.1 documentation 75 1 3 8 28553 KDE 3.2 documentation 77 2 2 9 36283 Gnome 2.6 78 16 34 51 18025 ******** * WHAT * ******** Debian already have very strong infrastructures to handle things like package recompilation (dbuilder), package mirroring, distribution handling (katie), bugs (debbugs), web page mirroring, etc. This package contains dl10n, the Debian localisation infrastructure. It is composed of several programs: dl10n-check: dig into the source packages looking for stuff to translate ----------- For now, it actually opens the source package and look for stuff to translate, and in the near future, a cooperative mode will be added, allowing the packager to specify this information in a 'debian/dl10n' file. Materials (=stuff to translate) are saved somewhere for later use by translators, and statistics are placed in a database because everybody loves neat graphics. dl10n-spider: reads the translator mailing lists seeking for status update (STILL TO DO) ------------ Most of the translator teams use a mailing list for coordination. Since the amount of exchanged mails can become rather big, several teams decided to normalize the title of their emails so that members can decide to read the mail or not from the title. The information indicated that way are the concerned program, the action of the mail author (intend to translate, translation to review, text sent to the packager), whether it is a program or documentation translation, etc. This system greatly improved member interactions, but one of the issues is that people get easily lost, and that you have to find a backup to make sure that no mail, no translation, no review gets lost on the way. dl10n-spider is this backup. It extracts statistics from the mailing list archives, easing the detection of such loss, or preventing any effort dupplication. dl10n-txt: generate textual statistic views dl10n-html: generates the debian web pages (STILL TO DO) ---------- Everybody loves statistics. Those two scripts should be merged into 'dl10n-stats'. dl10n-bot: central coordination robot (STILL TO DO) ---------- It would be possible to use a regular svn server there, but I prefer a specialized overlay. For example, it does not require to open an account on the host for each participant. dl10n-trans: translator interface (STILL TO DO) ------------ Simple interface to the most common translator tasks: request more material to translate, submit your work, ask for reviews, deal with reviews, check whether the translation you did so far are still uptodate, be informed if it's not the case anymore, report typo to developer, etc. dl10n-devel: developer interface (STILL TO DO) ------------ Simple interface to the most common developer (packager) tasks: declare what should be translated, retrieve the work of translators, alert them before next release... **************** * DEPENDENCIES * **************** libwww-perl, and libnet-ldap-perl or libsoap-lite-perl are needed by the spider. ******* * WHO * ******* The main authors of dl10n are Martin Quinson and Denis Barbier. dl10n-spider was made by Tim Dijkstra and Nicolas Bertolissio. dl10n-3.00/dl10n-rrd/0000755000000000000000000000000011704570256010752 5ustar dl10n-3.00/dl10n-rrd/example/0000755000000000000000000000000011544665454012414 5ustar dl10n-3.00/dl10n-rrd/example/colors.sh0000644000000000000000000000323011544665454014247 0ustar #!/bin/sh # colors.sh -- Compute RGB color codes of easily discernible colors. # # Copyright (C) 2007 Nicolas François # # 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 2 of the License, or # (at your option) any later version. # # This shell script contains 2 functions: # hsv_to_rgb # Internal function # # get_color(number, index) # Can be used to generate color codes for up to number colors. # You should call get_color() with the same number of colors, # incrementing index after each call. # hsv_to_rgb() { h=$(($1 % 360)) i=$((h * 6 / 360)) case $i in 0) r=255 g=$(( h * 255 * 6 / 360 )) b=0 ;; 1) r=$(( 2 * 255 - h * 255 * 6 / 360 )) g=255 b=0 ;; 2) r=0 g=255 b=$(( h * 255 * 6 / 360 - 2 * 255 )) ;; 3) r=0 g=$(( 4 * 255 - h * 255 * 6 / 360 )) b=255 ;; 4) r=$(( h * 255 * 6 / 360 - 4 * 255 )) g=0 b=255 ;; 5) r=255 g=0 b=$(( 6 * 255 - h * 255 * 6 / 360 )) ;; esac printf "%02x%02x%02x" $r $g $b } get_color() { # number of colors n=$1 # index of the color i=$2 case $(( i % 2 )) in 0) hsv_to_rgb $(( (i/2)*180/((n+1)/2) )) ;; 1) hsv_to_rgb $(( ((i-1)/2)*180/((n+1)/2) + 180 )) ;; esac } dl10n-3.00/dl10n-rrd/example/graph_ranks.sh0000755000000000000000000000462711544665454015263 0ustar #!/bin/bash set -e # graph_ranks.sh # # Create a graph representing the variations of translated strings for the # given format and the given languages # # Copyright (C) 2007 Nicolas François # # 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 2 of the License, or # (at your option) any later version. # if [ $# -lt 2 ] then echo "Usage: $0 [-o file] [-- rrdtool_options]" >&2 echo "formats: po, podebconf, po4a" >&2 echo "rrdtool_options defaults to $rrdtool_options" >&2 exit 1 fi . $(dirname $0)/colors.sh rrdtool_options="--start now-2d" if [ "$1" = "-o" ] then output="$2" shift 2 fi fmt=$1 shift if [ -z "$output" ] then output="$fmt.png" fi languages="" n=0 while true do arg=$1 if [ -z "$arg" ] then # End of languages & rrdtool options break else if [ "$arg" = "--" ] then # Begining of the rrdtool options shift rrdtool_options=$@ break else languages="$languages $arg" n=$((n+1)) fi fi # Next argument shift done export LC_ALL=C a=0 #echo -n "Generating $fmt.png... " rrdtool graph "$output" \ --units-exponent 0 \ --height 200 \ --title "$fmt strings" \ --vertical-label "strings" \ $rrdtool_options \ DEF:total=$fmt/__.rrd:u:AVERAGE \ VDEF:vdeftotal=total,LAST \ $(for l in $languages; do echo -n " DEF:$l=$fmt/$l.rrd:t:AVERAGE" echo -n " VDEF:vdef$l=$l,LAST" done) \ LINE:total#000000:total \ GPRINT:vdeftotal:%6.0lf\\l \ $(for l in $languages; do echo -n " LINE:$l#$(get_color $n $a):$l" echo -n " GPRINT:vdef$l:%6.0lf" [ "$(( a % 4 ))" = "3" ] && echo -n "\l" a=$((a+1)) done) \ COMMENT:\\s \ COMMENT:\\s \ COMMENT:"$(date|sed 's/:/\\:/g')" \ COMMENT:"Comments\: debian-l10n-devel@lists.alioth.debian.org" \ > /dev/null #echo "done." dl10n-3.00/dl10n-rrd/example/config.sh0000644000000000000000000000056511544665454014223 0ustar # Location were the generated files are written (for each suite, the RRD # files are written in the po, po4a, podebconf, and man subdirectories; # the graphs are written in man.png and in the week, month and year # subdirectories). RRD_HOME=/srv/i18n.debian.net/www/debian-l10n-stats # Location of the debian-l10n working directory DL10N_HOME=/srv/dl10n-stuff/svn/dl10n/ dl10n-3.00/dl10n-rrd/example/make_index.sh0000755000000000000000000000430111544665454015055 0ustar #!/bin/sh export LC_ALL=C echo " " > index.html for lang in po-*.png do lang=${lang%.png} lang=${lang#po-} if [ $lang = "_" ] || [ $lang = "__" ] || [ $lang = "___" ] then continue fi echo " " >> index.html for f in po po4a podebconf do echo " " >> index.html done echo " " >> index.html done echo "
language PO po4a po-debconf
ranks po.png po4a.png podebconf.png
$lang" >> index.html if [ -f $f-$lang.png ] then echo " $f-$lang.png" >> index.html else echo " -" >> index.html fi echo "

These statistics are done with these data. You can also find the scripts generating these graph and data there. The are also RRD files for the po4a strings and every PO's strings. An unstable, unstable with BTS and testing version of this page exists.
In this graphs, the no po and untranslated categories differ. The untranslated category indicate the number of strings which are not translated in the distributed PO files. The no po category is an estimation of the number of strings which are not translated because there is no PO files for the given language. This estimation is correct for the po4a and podebconf famillies, but is just an approximative number for the po familly because of missing POT files (in that case, the biggest PO file is considered). " >> index.html dl10n-3.00/dl10n-rrd/example/update_unstable.sh0000755000000000000000000000465611544665454016145 0ustar #!/bin/sh set -e # update_unstable.sh # # Update the RRD database for the unstable suite, and generate the graphs. # RRD and graphs are also generated for the unstable manpages. # # Copyright (C) 2007 Nicolas François # # 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 2 of the License, or # (at your option) any later version. # GRAPH_SCRIPTS_DIR=$(dirname $0) . $GRAPH_SCRIPTS_DIR/config.sh dist=unstable export LC_ALL=C cd $RRD_HOME/${dist}/ if [ ! -e /srv/i18n.debian.net/www/debian-l10n-material/data/$dist.gz ] then echo "No /srv/i18n.debian.net/www/debian-l10n-material/data/$dist.gz! Exiting." exit 1 fi gunzip -c /srv/i18n.debian.net/www/debian-l10n-material/data/$dist.gz > $dist PERLLIB=$DL10N_HOME/lib $DL10N_HOME/dl10n-rrd/dl10n-rrd --db=$dist for period in week month year do if [ ! -d "$period" ] then mkdir "$period" fi for fmt in po po4a podebconf do # Hardcoded list of languages, based on the current ranks (2007 03 03) range="" case $fmt in po) languages="fr de es it sv ru nl ja pt_BR pl cs" ;; podebconf) range="--upper-limit 11000 --lower-limit 5000 --rigid"; languages="fr cs de sv vi ja nl es pt_BR pt ru gl" ;; po4a) languages="fr es ja ru de ca pl it sv pt_BR uk ko el tr hu" ;; esac $GRAPH_SCRIPTS_DIR/graph_ranks.sh \ -o "$period/$fmt.png" \ "$fmt" \ $languages \ -- \ --zoom 1.5 --start end-1$period --end 00:00+1d \ $range case $fmt in podebconf) range="--upper-limit 11000 --lower-limit 0 --rigid";; esac for lang in $fmt/*.rrd do lang=$(basename $lang) lang=${lang%.rrd} $GRAPH_SCRIPTS_DIR/graph_lang.sh \ -o "$period/$fmt-$lang.png" \ "$fmt" \ "$lang" \ $range \ --start end-1$period --end 00:00+1d done done done rm -f $dist # # man pages # $DL10N_HOME/dl10n-rrd/manpages-rrd.pl $dist languages="ja fr es pl de ko zh_CN zh_TW pt it ru" $GRAPH_SCRIPTS_DIR/manpages_graph_ranks.sh \ $languages \ -- \ --zoom 1.5 \ --start end-1month --end 00:00+1d dl10n-3.00/dl10n-rrd/example/update_testing.sh0000755000000000000000000000437311544665454016001 0ustar #!/bin/sh set -e # update_testing.sh # # Update the RRD database for the testing suite, and generate the graphs. # RRD and graphs are also generated for the testing manpages. # # Copyright (C) 2007 Nicolas François # # 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 2 of the License, or # (at your option) any later version. # GRAPH_SCRIPTS_DIR=$(dirname $0) . $GRAPH_SCRIPTS_DIR/config.sh dist=testing export LC_ALL=C cd $RRD_HOME/${dist}/ gunzip -c /srv/i18n.debian.net/www/debian-l10n-material/data/$dist.gz > $dist PERLLIB=$DL10N_HOME/lib $DL10N_HOME/dl10n-rrd/dl10n-rrd --db=$dist for period in week month year do if [ ! -d "$period" ] then mkdir "$period" fi for fmt in po po4a podebconf do # Hardcoded list of languages, based on the current ranks (2007 03 03) range="" case $fmt in po) languages="fr de es it sv ru nl ja pt_BR pl cs" ;; podebconf) range="--upper-limit 11000 --lower-limit 5000 --rigid"; languages="fr cs de sv vi ja nl es pt_BR pt ru gl" ;; po4a) languages="fr es ja ru de ca pl it sv pt_BR uk ko el tr hu" ;; esac $GRAPH_SCRIPTS_DIR/graph_ranks.sh \ -o "$period/$fmt.png" \ "$fmt" \ $languages \ -- \ --zoom 1.5 --start end-1$period --end 00:00+1d \ $range case $fmt in podebconf) range="--upper-limit 11000 --lower-limit 0 --rigid";; esac for lang in $fmt/*.rrd do lang=$(basename $lang) lang=${lang%.rrd} $GRAPH_SCRIPTS_DIR/graph_lang.sh \ -o "$period/$fmt-$lang.png" \ "$fmt" \ "$lang" \ $range \ --start end-1$period --end 00:00+1d done done done rm -f $dist # # man pages # $DL10N_HOME/dl10n-rrd/manpages-rrd.pl $dist languages="ja fr es pl de ko zh_CN zh_TW pt it ru" $GRAPH_SCRIPTS_DIR/manpages_graph_ranks.sh \ $languages \ -- \ --zoom 1.5 \ --start end-1month --end 00:00+1d dl10n-3.00/dl10n-rrd/example/resize_rrd.sh0000755000000000000000000000133511544665454015125 0ustar #!/bin/sh set -e # This is just an example on how the rrd files can be enlarged. # When I did it, the rrd file already lost some data, so I had to merge # different sources 'see the commented parts) find debian-l10n-stats/ -name "*.rrd" | while read file do # dump=dump # olddump=olddump # newdump=newdump # rm -f $dump $olddump $newdump # # oldfile=www-rrd${file#debian-l10n-stats} # # if [ -f $oldfile ]; then # rrdtool dump $file > $dump # rrdtool dump $oldfile > $olddump # # head -n 73 $dump >> $newdump # tail -n +74 $olddump | grep "2007-" >> $newdump # tail -n +74 $dump | grep -v "2007-" >> $newdump # rm -f $file # rrdtool restore $newdump $file # fi rrdtool resize $file 0 GROW 700 done dl10n-3.00/dl10n-rrd/example/graph_lang.sh0000755000000000000000000000350711544665454015062 0ustar #!/bin/bash set -e # graph_lang.sh # # Create a graph representing the variations of the translated, fuzzy and # untranslated strings for the given format and language. # The statistics are displayed as an histogram. # # Copyright (C) 2007 Nicolas François # # 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 2 of the License, or # (at your option) any later version. # rrdtool_options="--start now-2d" if [ $# -lt 2 ] then echo "Usage: $0 [-o file] [rrdtool_options]" >&2 echo "formats: po, podebconf, po4a" >&2 echo "rrdtool_options defaults to $rrdtool_options" >&2 exit 1 fi if [ "$1" = "-o" ] then output="$2" shift 2 fi fmt=$1 lang=$2 if [ -z "$output" ] then output="$fmt-$lang.png" fi if [ $# -gt 2 ] then rrdtool_options=${@:3} fi if [ ! -f $fmt/$lang.rrd ] then echo "No such rrd file: $fmt/$lang.rrd" >&2 exit 1 fi export LC_ALL=C #echo -n "Generating $fmt-$lang.png... " rrdtool graph "$output" \ --lower-limit 0 \ --units-exponent 0 \ --height 200 \ --title "$fmt strings ($lang)" \ --vertical-label "strings" \ $rrdtool_options \ DEF:t=$fmt/$lang.rrd:t:AVERAGE \ DEF:f=$fmt/$lang.rrd:f:AVERAGE \ DEF:u=$fmt/$lang.rrd:u:AVERAGE \ DEF:total=$fmt/__.rrd:u:AVERAGE \ CDEF:nopo=total,t,-,f,-,u,- \ AREA:t#00FF00:translated:STACK \ AREA:f#0000FF:fuzzy:STACK \ AREA:u#FF0000:untranslated:STACK \ AREA:nopo#FFFF00:"no po":STACK \ COMMENT:"$(date|sed 's/:/\\:/g')" \ COMMENT:"Comments\: debian-l10n-devel@lists.alioth.debian.org" \ > /dev/null #echo "done." dl10n-3.00/dl10n-rrd/example/manpages_graph_ranks.sh0000755000000000000000000000413611544665454017131 0ustar #!/bin/bash set -e # graph_ranks.sh # # Create a graph representing the variations of translated manpages for # the given languages # # Copyright (C) 2007 Nicolas François # # 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 2 of the License, or # (at your option) any later version. # if [ $# -lt 2 ] then echo "Usage: $0 [-- rrdtool_options]" >&2 echo "formats: po, podebconf, po4a" >&2 echo "rrdtool_options defaults to $rrdtool_options" >&2 exit 1 fi . $(dirname $0)/colors.sh rrdtool_options="--start now-2d" firstlang=$1 shift languages=$firstlang n=1 while true do arg=$1 if [ -z "$arg" ] then # End of languages & rrdtool options break else if [ "$arg" = "--" ] then # Begining of the rrdtool options shift rrdtool_options=$@ break else languages="$languages $arg" n=$((n+1)) fi fi # Next argument shift done export LC_ALL=C a=0 #echo -n "Generating man.png... " rrdtool graph man.png \ --units-exponent 0 \ --lower-limit 0 \ --height 200 \ --title "manpages" \ --vertical-label "manpages (%)" \ $rrdtool_options \ DEF:total1=man/_.rrd:translated:AVERAGE \ DEF:total2=man/_.rrd:only:AVERAGE \ CDEF:total=total1,total2,+ \ $(for l in $languages; do echo -n " DEF:${l}1=man/$l.rrd:translated:AVERAGE" echo -n " DEF:${l}2=man/$l.rrd:only:AVERAGE" echo -n " CDEF:$l=${l}1,${l}2,+,total,/,100,*" done) \ $(for l in $languages; do echo -n " LINE:$l#$(get_color $n $a):$l" a=$((a+1)) done) \ COMMENT:"$(date|sed 's/:/\\:/g')" > /dev/null #echo "done." dl10n-3.00/dl10n-rrd/example/update_unstableBTS.sh0000755000000000000000000000410711544665454016505 0ustar #!/bin/sh set -e # update_unstableBTS.sh # # Update the RRD database for the unstable suite, taking the BTS into # account, and generate the graphs. # # Copyright (C) 2007 Nicolas François # # 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 2 of the License, or # (at your option) any later version. # GRAPH_SCRIPTS_DIR=$(dirname $0) . $GRAPH_SCRIPTS_DIR/config.sh dist=unstable export LC_ALL=C cd $RRD_HOME/${dist}BTS/ gunzip -c /srv/i18n.debian.net/www/debian-l10n-material/data/$dist.gz > $dist PERLLIB=$DL10N_HOME/lib $DL10N_HOME/dl10n-rrd/dl10n-rrd --db=$dist \ --assume-bts --sdb=$DL10N_HOME'/data/status.$lang' for period in week month year do if [ ! -d "$period" ] then mkdir "$period" fi for fmt in po po4a podebconf do # Hardcoded list of languages, based on the current ranks (2007 03 03) range="" case $fmt in po) languages="fr de es it sv ru nl ja pt_BR pl cs" ;; podebconf) range="--upper-limit 11000 --lower-limit 5000 --rigid"; languages="fr cs de sv vi ja nl es pt_BR pt ru gl" ;; po4a) languages="fr es ja ru de ca pl it sv pt_BR uk ko el tr hu" ;; esac $GRAPH_SCRIPTS_DIR/graph_ranks.sh \ -o "$period/$fmt.png" \ "$fmt" \ $languages \ -- \ --zoom 1.5 --start end-1$period --end 00:00+1d \ $range case $fmt in podebconf) range="--upper-limit 11000 --lower-limit 0 --rigid";; esac for lang in $fmt/*.rrd do lang=$(basename $lang) lang=${lang%.rrd} $GRAPH_SCRIPTS_DIR/graph_lang.sh \ -o "$period/$fmt-$lang.png" \ "$fmt" \ "$lang" \ $range \ --start end-1$period --end 00:00+1d done done done rm -f $dist dl10n-3.00/dl10n-rrd/manpages-rrd.pl0000755000000000000000000000610311704570256013672 0ustar #!/usr/bin/perl # manpages-rrd.pl -- Debian l10n manpages statistics (rrd format) # # Copyright (C) 2007 Nicolas François # # 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 2 of the License, or # (at your option) any later version. # # Usage: manpages-rrd.pl # suite: testing, unstable my $MIRROR="ftp://ftp.es.debian.org/debian"; my $RRD_DATE; my $dist = $ARGV[0]; my @archs; if ($dist eq "stable") { @archs = qw/amd64 armel i386 ia64 kfreebsd-amd64 kfreebsd-i386 mipsel powerpc sparc/; } elsif ($dist eq "testing") { @archs = qw/amd64 armel i386 ia64 kfreebsd-amd64 kfreebsd-i386 mipsel powerpc/; } elsif ($dist eq "unstable") { @archs = qw/amd64 armel i386 ia64 kfreebsd-amd64 kfreebsd-i386 mipsel powerpc/; } my %mans; for my $arch (@archs) { if (-f "Contents-$arch.gz") { unlink "Contents-$arch.gz"; } system ("wget", "-c", "--quiet", "$MIRROR/dists/$dist/Contents-$arch.gz") == 0 or die "wget failed to download $MIRROR/dists/$dist/Contents-$arch.gz . Aborting."; die "Missing Contents-$arch.gz . Aborting." unless -f "Contents-$arch.gz"; open(CONTENT, "gunzip -c 'Contents-$arch.gz'|") or die "Cannot open 'Contents-$arch.gz'"; while() { if ($_ =~ m|^usr/share/man/(?:(.*?)/)?(man[0-9]/.*?)[\t ]+(.*)$|) { my $lang=$1||"_"; my $man=$2; my $pkgs=$3; $man =~ s/\.gz$//; $mans{$man}{$lang}.=",$pkg"; } } close(CONTENT) or die "Cannot close 'Contents-$arch.gz'"; unlink "Contents-$arch.gz"; } my %total; my %total_translated_only; my $lang; foreach my $man (keys %mans) { if (defined $mans{$man}{'_'}) { foreach $lang (keys %{$mans{$man}}) { $total{$lang} += 1; $langs{$lang} = 1; } } else { $total_translated_only{'_'} += 1; foreach $lang (keys %{$mans{$man}}) { $total_translated_only{$lang} += 1; $langs{$lang} = 1; # print "no English page: $man ($lang)\n"; } } } my $step = 60*60*24; # 1 day if ( ! -d "man") { mkdir "man"; } foreach $lang (sort keys %langs) { if ( ! -f "man/$lang.rrd") { system "rrdtool create man/$lang.rrd ". "--step $step ". ((not defined $RRD_DATE or $RRD_DATE eq "N")?"":"--start ".($RRD_DATE)." "). "DS:translated:GAUGE:".($step*1.5).":U:U ". "DS:only:GAUGE:".($step*1.5).":U:U ". "RRA:AVERAGE:0.5:1:700"; } my $date="N"; if (defined $RRD_DATE) { if ($RRD_DATE ne "N") { $date = $RRD_DATE+1; } } else { use POSIX qw(strftime); $date = strftime "%s", localtime; $date = (int($date / $step)+1)*$step } system "rrdtool update man/$lang.rrd $date:". $total{$lang}.":". $total_translated_only{$lang}; } dl10n-3.00/dl10n-rrd/README0000644000000000000000000000023611544665454011642 0ustar dl10n-rrd creates RRD files. The example directory contains scripts which use these RRD files to generate graphs representing the evolution of translations. dl10n-3.00/dl10n-rrd/dl10n-rrd0000755000000000000000000002517311544665454012422 0ustar #! /usr/bin/perl -w # dl10n-rrd -- Debian l10n statistics (rrd format) # # Copyright (C) 2007 Nicolas François # # Based on dl10n-txt: # Copyright (C) 2004 Martin Quinson # # 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 2 of the License, or # (at your option) any later version. # # WARNING: This script must not be run twice per day # (see also the step variable below) # This script should not be run between 01H00 and the update of the # database. # use strict; use Getopt::Long; #to parse the args my $progname= $0; $progname= $& if $progname =~ m,[^/]+$,; my $VERSION = "1.0"; #External Version Number my $BANNER = "Debian l10n infrastructure -- rrd statistics extractor v$VERSION"; # Version Banner - text form my $DB_FILE="./data/status"; my $IGNORE_FILE=''; my $RRD_DATE; my $STATUS_FILE='./data/status.$lang'; my $assume_bts = 0; use Debian::L10n::Db; sub syntax_msg { my $msg = shift; if (defined $msg) { print "$progname: $msg\n"; } else { print "$BANNER\n"; } print "Syntax: $0 [options] General options: -h, --help display short help text -V, --version display version and exit Informations to display: -a,--assume-bts Assume that the content bugs in the BTS were applied. Database to use: --db=DB_FILE use DB_FILE as database file (instead of $DB_FILE) --idb=IGNORE_FILE use IGNORE_FILE as list of packages to ignore --sdb=STATUS_FILE use STATUS_FILE as status file (instead of $STATUS_FILE) --date=RRD_DATE RRD start date (in secondes since Epoch). Default date is the current time rounded to the end of the current step. "; if (defined $msg) { exit 1; } else { exit 0; } } # Display Version Banner # Options: -V|--version, --print-version sub banner { if ($_[0] eq 'print-version') { print "$VERSION\n"; } else { print "$BANNER\n"; } exit 0; } # Hash used to process commandline options my %opthash = ( # ------------------ general options "help|h" => \&syntax_msg, "version|V" => \&banner, "print-version" => \&banner, # ------------------ configuration options "assume-bts|a" => \$assume_bts, "db=s" => \$DB_FILE, "idb=s" => \$IGNORE_FILE, "sdb=s" => \$STATUS_FILE, "date=i" => \$RRD_DATE, ); # init commandline parser Getopt::Long::config('bundling', 'no_getopt_compat', 'no_auto_abbrev'); # process commandline options GetOptions(%opthash) or syntax_msg("error parsing options"); #----------------------------------------------------------------------------- # The main program #----------------------------------------------------------------------------- ### ### initialisation ### my $data = Debian::L10n::Db->new(); $data->read($DB_FILE); my %ignored_pkgs = (); if ($IGNORE_FILE) { open IGNORE, "$IGNORE_FILE" or die "Impossible to read the ignore file $IGNORE_FILE\n"; while () { chomp; next unless $_; $ignored_pkgs{$_} = 1; } close IGNORE; } my @poparts=qw(po podebconf po4a); # Only POs, no template or man my %total; foreach my $pkg ($data->list_packages()) { next if defined $ignored_pkgs{$pkg}; my (%score,%ori); foreach my $part (@poparts) { my $has_part="has_$part"; $score{$part} = {}; if ($data->$has_part($pkg)) { foreach my $line (@{$data->$part($pkg)}){ my ($pofile, $lang, $stat) = @{$line}; if (defined $lang and length $lang) { $score{$part}{$lang} = add_stat($stat, $score{$part}{$lang}); } } my $lang; if ($assume_bts and defined $total{$part}) { foreach $lang (keys %{$total{$part}}) { # FIXME: as we do not have the list of languages, we can only # check the BTS for the languages with a translation in # the previous packages. # This should be mostly OK. if (defined $score{$part}{'_'} and length $score{$part}{'_'}) { $score{$part}{$lang} = merge_bts_stats($pkg, $lang, $part, $score{$part}{$lang}, $score{$part}{'_'}); } } } unless (defined $score{$part}{'_'}) { # If there is not POT file, try to find the number of strings # from the other PO. This is usually a sign for non up to date # PO files, so the number of strings in the PO files may vary. # I choose to take the greatest number. # This is a bug and should be reported. my $t = 0; foreach $lang (keys %{$score{$part}}) { if (tot($score{$part}{$lang})>$t) { $t = tot($score{$part}{$lang}); } } $score{$part}{'__'}="0t0f".$t."u"; } else { $score{$part}{'__'}=$score{$part}{'_'}; } { my $t = 0; foreach $lang (keys %{$score{$part}}) { if (tot($score{$part}{$lang})>$t) { $t = tot($score{$part}{$lang}); } } $score{$part}{'___'}="0t0f".$t."u"; } # Here we could also check that every pkg has the same number of # strings for each language. foreach $lang (keys %{$score{$part}}) { if (defined $score{$part}{$lang} && $score{$part}{$lang} ne '---') { $total{$part}{$lang} = add_stat($score{$part}{$lang}, $total{$part}{$lang}); } # QA: # if (tot($score{$part}{$lang}) > tot($score{$part}{'__'})) { # print "$lang > _ for $pkg ($part)\n"; # print " '".$score{$part}{$lang}." / ".($score{$part}{'_'}||"")."\n"; # } } } } } foreach my $part (@poparts) { foreach my $lang (keys %{$total{$part}}) { my $stats = $total{$part}{$lang}; my $t = "0"; my $f = "0"; my $u = "0"; if ($stats =~ /([0-9]+)t/) { $t=$1; } if ($stats =~ /([0-9]+)f/) { $f=$1; } if ($stats =~ /([0-9]+)u/) { $u=$1; } if ($t+$f+$u == 0) { # We do not process this language anymore. This is most # probably an (old) error in the language code and there are no # PO files anymore # warn "Wrong stats format. part: $part, lang: $lang, stats: $stats.\n"; next; } if ( ! -d $part) { mkdir $part; } my $step = 60*60*24; # 1 day if ( ! -f "$part/$lang.rrd") { system "rrdtool create $part/$lang.rrd ". "--step $step ". ((not defined $RRD_DATE or $RRD_DATE eq "N")?"":"--start ".($RRD_DATE)." "). "DS:t:GAUGE:".($step*1.5).":U:U ". "DS:f:GAUGE:".($step*1.5).":U:U ". "DS:u:GAUGE:".($step*1.5).":U:U ". "RRA:AVERAGE:0.5:1:700"; } my $date="N"; if (defined $RRD_DATE) { if ($RRD_DATE ne "N") { $date = $RRD_DATE+1; } } else { use POSIX qw(strftime); $date = strftime "%s", localtime; $date = (int($date / $step)+1)*$step } system "rrdtool update $part/$lang.rrd $date:$t:$f:$u"; } } sub add_stat { my $new=shift; my $old=shift; return $new unless ($old); return $new if ($old eq '---'); $new =~ /([0-9]*)t([0-9]*)f([0-9]*)u/; my ($nt,$nf,$nu) = ($1||0, $2||0, $3||0); $old =~ /([0-9]*)t([0-9]*)f([0-9]*)u/; my ($ot,$of,$ou) = ($1||0, $2||0, $3||0); my $res= ($nt+$ot)."t".($nf+$of)."f".($nu+$ou)."u"; return $res; } sub normalize_score { my $orig=shift; my $trans=shift; $orig =~ /([0-9]*)t([0-9]*)f([0-9]*)u/; my ($ot,$of,$ou) = ($1||0, $2||0, $3||0); $trans =~ /([0-9]*)t([0-9]*)f([0-9]*)u/; my ($tt,$tf,$tu) = ($1||0, $2||0, $3||0); my $res= ($tt)."t".($tf)."f".($ot+$of+$ou-$tf-$tt)."u"; return $res; } sub output_details { my $stats = shift||""; my $t = "0"; my $u = "0"; my $f = "0"; if ($stats =~ /([0-9]+)t/) { $t=$1; } if ($stats =~ /([0-9]+)u/) { $u=$1; } if ($stats =~ /([0-9]+)f/) { $f=$1; } return ($t+$f+$u == 0 ? $stats : "$t:$f:$u"); } my %statusDB; sub merge_bts_stats { my $pkg = shift; my $lang = shift; my $part = shift; my $stats = shift; my $ori = shift; return $stats unless $assume_bts; unless (defined $statusDB{$lang}) { my $statusDBname = "$STATUS_FILE"; $statusDBname =~ s/\$lang/$lang/g; return $stats unless ( -f $statusDBname ); $statusDB{$lang} = Debian::L10n::Db->new(); $statusDB{$lang}->read($statusDBname,0); } return $stats unless ( $statusDB{$lang}->has_package($pkg) && $statusDB{$lang}->has_status($pkg)); my $bts_reported = 0; foreach my $statusline (@{$statusDB{$lang}->status($pkg)}) { my ($kind,$file,$date,$status_from_db,$translator,$url,$bug_nb) = @{$statusline}; if ($kind eq $part) { if ($status_from_db =~ m/^(bts|done|hold|fix|wontfix)$/i) { $bts_reported = 1; } else { $bts_reported = 0; } } } if ($bts_reported) { $ori =~ /([0-9]*)t([0-9]*)f([0-9]*)u/; $stats = ($1+$2+$3)."t0f0u"; } return $stats; } sub tot { my $stats = shift; return 0 unless $stats; return 0 if $stats eq "---"; my $t = "0"; my $f = "0"; my $u = "0"; if ($stats =~ /([0-9]+)t/) { $t=$1; } if ($stats =~ /([0-9]+)f/) { $f=$1; } if ($stats =~ /([0-9]+)u/) { $u=$1; } return $t+$f+$u; } dl10n-3.00/dl10n-pts0000755000000000000000000003511411544665464010733 0ustar #! /usr/bin/perl -w # dl10n-pts -- Debian l10n PTS links # # Copyright (C) 2009 Nicolas François # # Based on dl10n-txt: # Copyright (C) 2004 Martin Quinson # # 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 2 of the License, or # (at your option) any later version. # use strict; use Getopt::Long; #to parse the args use Time::gmtime; use POSIX qw(strftime); my $progname= $0; $progname= $& if $progname =~ m,[^/]+$,; my $VERSION = "1.0"; #External Version Number my $BANNER = "Debian l10n infrastructure -- PTS support v$VERSION"; # Version Banner - text form my $DB_FILE="./data/status"; my $IGNORE_FILE=''; my $GENDIR="l10n-pkg-status"; my $STATUS_FILE='./data/status.$lang'; my $assume_bts = 0; use Debian::L10n::Db; sub syntax_msg { my $msg = shift; if (defined $msg) { print "$progname: $msg\n"; } else { print "$BANNER\n"; } print "Syntax: $0 [options] General options: -h, --help display short help text -V, --version display version and exit Informations to display: -a,--assume-bts Assume that the content bugs in the BTS were applied. Database to use: --db=DB_FILE use DB_FILE as database file (instead of $DB_FILE) --idb=IGNORE_FILE use IGNORE_FILE as list of packages to ignore --sdb=STATUS_FILE use STATUS_FILE as status file (instead of $STATUS_FILE) --gendir Generate the files in this directory "; if (defined $msg) { exit 1; } else { exit 0; } } # Display Version Banner # Options: -V|--version, --print-version sub banner { if ($_[0] eq 'print-version') { print "$VERSION\n"; } else { print "$BANNER\n"; } exit 0; } # Hash used to process commandline options my %opthash = ( # ------------------ general options "help|h" => \&syntax_msg, "version|V" => \&banner, "print-version" => \&banner, # ------------------ configuration options "assume-bts|a" => \$assume_bts, "db=s" => \$DB_FILE, "idb=s" => \$IGNORE_FILE, "sdb=s" => \$STATUS_FILE, "gendir=s" => \$GENDIR, ); # init commandline parser Getopt::Long::config('bundling', 'no_getopt_compat', 'no_auto_abbrev'); # process commandline options GetOptions(%opthash) or syntax_msg("error parsing options"); #----------------------------------------------------------------------------- # The main program #----------------------------------------------------------------------------- ### ### initialisation ### my $data = Debian::L10n::Db->new(); $data->read($DB_FILE); my %ignored_pkgs = (); if ($IGNORE_FILE) { open IGNORE, "$IGNORE_FILE" or die "Impossible to read the ignore file $IGNORE_FILE\n"; while () { chomp; next unless $_; $ignored_pkgs{$_} = 1; } close IGNORE; } my @poparts=qw(podebconf po po4a); # Only POs, no template or man my %score; my %errors; my %langs; foreach my $pkg ($data->list_packages()) { next if defined $ignored_pkgs{$pkg}; foreach my $part (@poparts) { my $has_part="has_$part"; if ($data->$has_part($pkg)) { foreach my $line (@{$data->$part($pkg)}){ my ($pofile, $lang, $stat) = @{$line}; if (defined $lang and length $lang) { $score{$pkg}{$part}{$lang} = add_stat($stat, $score{$pkg}{$part}{$lang}); $langs{$pkg}{$lang} = 1; } } unless (defined $score{$pkg}{$part}{'_'}) { # If there is no POT file, try to find the number of strings # from the other POs. This is usually a sign for non up to date # PO files, so the number of strings in the PO files may vary. # I choose to take the greatest number. my $t = 0; foreach my $lang (keys %{$langs{$pkg}}) { if ( (defined $score{$pkg}{$part}{$lang}) and (tot($score{$pkg}{$part}{$lang}) > $t)) { $t = tot($score{$pkg}{$part}{$lang}); } } $score{$pkg}{$part}{'__'} = "0t0f".$t."u"; } else { $score{$pkg}{$part}{'__'} = $score{$pkg}{$part}{'_'}; } } } if ($data->has_errors($pkg)) { foreach my $line (@{$data->errors($pkg)}){ $errors{$pkg} = "" unless defined $errors{$pkg}; $errors{$pkg}.=$line } } } my %global_score; foreach my $pkg (keys %score) { foreach my $lang (keys %{$langs{$pkg}}) { if ($lang ne "_" and $lang ne "__") { foreach my $part (keys %{$score{$pkg}}) { next unless defined $score{$pkg}{$part}{$lang}; if ($part eq "podebconf") { $global_score{$pkg}{debian} = add_stat ($score{$pkg}{$part}{$lang}, $global_score{$pkg}{debian}); } elsif ($part eq "po") { # FIXME: use heuristics or control field $global_score{$pkg}{nondebian} = add_stat ($score{$pkg}{$part}{$lang}, $global_score{$pkg}{nondebian}); } elsif ($part eq "po4a") { $global_score{$pkg}{debian} = add_stat ($score{$pkg}{$part}{$lang}, $global_score{$pkg}{debian}); } } } } } open PKGLIST, ">$GENDIR/pkglist" or die "Cannot open $GENDIR/pkglist: $!"; print PKGLIST < () # The scores are: # - debian translations: po-debconf and po4a translation # - non debian translations: other PO files. # Scores are currently the percentage of translated strings in the existing PO # files. # indicates if some work is needed on the translations # EOF my $gmt = gmtime; print PKGLIST "# Generated on: ".(POSIX::strftime "%Y-%m-%d %H:%M:%S", @$gmt)." UTC (db: ".$data->get_date().")\n"; foreach my $pkg (sort keys %global_score) { my $pkgstatus = pkg_letter($pkg)."/$pkg.html"; next unless ( ( (defined $global_score{$pkg}{debian}) and ($global_score{$pkg}{debian} ne "0t0f0u")) or ( (defined $global_score{$pkg}{nondebian}) and ($global_score{$pkg}{nondebian} ne "0t0f0u"))); my $todo = 0; if (defined $errors{$pkg}) { $todo = 1; } unless (-d "$GENDIR/".pkg_letter($pkg)) { mkdir "$GENDIR/".pkg_letter($pkg); } open PKGSTATUS,">$GENDIR/$pkgstatus" or die "Cannot open $GENDIR/$pkgstatus: $!"; print PKGSTATUS < Translation status of package $pkg EOF if (defined $errors{$pkg}) { print PKGSTATUS <Your package's translations have errors
You can check if a PO file is valid with the following command: 

        msgfmt -c -o /dev/null <po file>
The following errors were found in $pkg 's PO files: 
$errors{$pkg}
Please ask the translator (identified by the Last-Translator field in the PO file), the language team (identified by the Language-Team field) or debian-i18n for a fix.
EOF } if (defined $score{$pkg}{"podebconf"}) { my $msg = ""; # Check if there are no up to date languages my $uptodate = 0; foreach my $lang (keys %{$score{$pkg}{"podebconf"}}) { if ( ($score{$pkg}{"podebconf"}{$lang} =~ m/^([0-9]+)t0f0u$/) and ($1 ne "0")) { $uptodate = 1; } } if (not $uptodate) { $todo = 1; $msg = < There are no up-to-date PO files in your package. You should call for translations before uploading to unstable. EOF } my $languages = scalar (keys %{$score{$pkg}{"podebconf"}}) - 2; if ($languages < 5) { # There are at least 5 very active translation teams: # es,de,pt,sv,cs $todo = 1; $msg = < You debconf templates are translated in only $languages languages. You should send a call for translations. EOF } if (length $msg) { print PKGSTATUS <Call for translation needed for package $pkg $msg
You can send a call for translation using the podebconf-report-po command (package po-debconf): 

        cd <po directory>
        podebconf-report-po --call
EOF } } print PKGLIST "$pkg ". $data->version($pkg). " (". output_percent($global_score{$pkg}{debian}). ",". output_percent($global_score{$pkg}{nondebian}). ") ". "http://i18n.debian.net/l10n-pkg-status/$pkgstatus". " ". $todo. "\n"; print PKGSTATUS <Translation status of package $pkg EOF print PKGSTATUS ""; print PKGSTATUS "" if defined $score{$pkg}{"podebconf"}; print PKGSTATUS "" if defined $score{$pkg}{"po"}; print PKGSTATUS "" if defined $score{$pkg}{"po4a"}; print PKGSTATUS "\n"; foreach my $lang (sort keys %{$langs{$pkg}}) { if ($lang ne "_" and $lang ne "__") { print PKGSTATUS " "; print PKGSTATUS "" if defined $score{$pkg}{"podebconf"}; print PKGSTATUS "" if defined $score{$pkg}{"po"}; print PKGSTATUS "" if defined $score{$pkg}{"po4a"}; print PKGSTATUS "\n"; } } my $date = strftime('%a, %d %b %Y %H:%M:%S %z', @$gmt); my $db_date = $data->get_date(); print PKGSTATUS <

Generated on $date (db: $db_date) by

Comments: Debian L10N Development Team

EOF close PKGSTATUS or die "Cannot close $GENDIR/$pkgstatus: $!"; } close PKGLIST or die "Cannot close $GENDIR/pkglist: $!"; sub pkg_letter { my $pkg = shift; if ($pkg =~ m/^(lib.)/) { return $1; } $pkg =~ s/^(.).*$/$1/; return $pkg; } sub add_stat { my $new=shift; my $old=shift; return $new unless ($old); return $new if ($old eq '---'); $new =~ /([0-9]*)t([0-9]*)f([0-9]*)u/; my ($nt,$nf,$nu) = ($1||0, $2||0, $3||0); $old =~ /([0-9]*)t([0-9]*)f([0-9]*)u/; my ($ot,$of,$ou) = ($1||0, $2||0, $3||0); my $res= ($nt+$ot)."t".($nf+$of)."f".($nu+$ou)."u"; return $res; } my %statusDB; sub merge_bts_stats { my $pkg = shift; my $lang = shift; my $part = shift; my $stats = shift; my $ori = shift; return $stats unless $assume_bts; unless (defined $statusDB{$lang}) { my $statusDBname = "$STATUS_FILE"; $statusDBname =~ s/\$lang/$lang/g; return $stats unless ( -f $statusDBname ); $statusDB{$lang} = Debian::L10n::Db->new(); $statusDB{$lang}->read($statusDBname,0); } return $stats unless ( $statusDB{$lang}->has_package($pkg) && $statusDB{$lang}->has_status($pkg)); my $bts_reported = 0; foreach my $statusline (@{$statusDB{$lang}->status($pkg)}) { my ($kind,$file,$date,$status_from_db,$translator,$url,$bug_nb) = @{$statusline}; if ($kind eq $part) { if ($status_from_db =~ m/^(bts|done|hold|fix|wontfix)$/i) { $bts_reported = 1; } else { $bts_reported = 0; last; } } } if ($bts_reported) { $ori =~ /([0-9]*)t([0-9]*)f([0-9]*)u/; $stats = ($1+$2+$3)."t0f0u"; } return $stats; } sub tot { my $stats = shift; return 0 unless $stats; return 0 if $stats eq "---"; my $t = "0"; my $f = "0"; my $u = "0"; if ($stats =~ /([0-9]+)t/) { $t=$1; } if ($stats =~ /([0-9]+)f/) { $f=$1; } if ($stats =~ /([0-9]+)u/) { $u=$1; } return $t+$f+$u; } sub output_percent { my $stats=shift||""; my $t = "0"; my $u = "0"; my $f = "0"; my $percent; if ($stats =~ /([0-9]*)t/) { $t=$1; } if ($stats =~ /([0-9]*)u/) { $u=$1; } if ($stats =~ /([0-9]*)f/) { $f=$1; } $percent = calc_percent($t,$t+$u+$f); if ($percent eq "NaN") { return '-'; } return "$percent"; } sub calc_percent{ my $up=shift; my $down=shift; my $res; if ($down==0) { return "NaN"; } $res = $up/$down*100; $res =~ s/^([0-9]*)\..*/$1/; return $res; } sub graph_stats { my $stats = shift||""; my %s = ( translated => 0, untranslated => 0, fuzzy => 0); if ($stats =~ /([0-9]*)t/) { $s{translated}=$1; } if ($stats =~ /([0-9]*)u/) { $s{untranslated}=$1; } if ($stats =~ /([0-9]*)f/) { $s{fuzzy}=$1; } my $total = scalar ($s{translated} + $s{untranslated} + $s{fuzzy}); return "" if $total == 0; my $graph = ""; foreach my $type (qw/translated fuzzy untranslated/) { my $pcent = scalar ($s{$type} * 100 / $total); my $width = scalar ($s{$type} * 100 / $total); $graph .= ""; } return $graph; } dl10n-3.00/dl10n-mail0000755000000000000000000000753611704574504011046 0ustar #!/usr/bin/perl -w use strict; use utf8; =head1 NAME dl10n-mail -- translator mailing lists (and BTS) robot for status updates =head1 SYNOPSIS dl10n-mail [options] lang+ =head1 DESCRIPTION This script can receive mails from the debian-l10n-ElanguageE mailing list or read an archivein thembox format. It looks for emails which title follow a specific format indicating what the author intend to translate, or the current status of his work on this translation. Those informations are saved to a dl10n database which can then be used to build a l10n coordination page or any other useless statistics. =cut use Getopt::Long; #to parse the args use Debian::L10n::Mail; my $progname = $0; $progname = $1 if $progname =~ m,([^/])+$,; my $VERSION = "1.0"; # External Version Number my $BANNER = "Debian l10n infrastructure -- mailing list parser v$VERSION"; # Version Banner - text form my $cmdline_file = undef; my $cmdline_msgid = undef; my $cmdline_mboxfolder = undef; my $check_bts=0; =head1 Command line option parsing =over =item General options: =over =item -h, --help display short help text =item -V, --version display version and exit =item --check-bts check the BTS =back =item Begin point of the crawling: =over =item --msgid=Message-ID =back if not specified, will crawl for new messages. =item ... =over =item --mboxfolder=MBOX_FOLDER ... =back =item Database to fill: =over =item --sdb=STATUS_FILE use STATUS_FILE as status file (instead of $STATUS_FILE) =back =back =cut # This is put into a block to avoid main namespace pollution { sub syntax_msg { my $message = shift; if (defined $message) { print "$progname: $message\n"; } else { print "$BANNER\n"; } print < \&syntax_msg, "version|V" => \&banner, "check-bts" => \$check_bts, # ------------------ configuration options "msgid=s" => \$cmdline_msgid, "mboxfolder=s"=> \$cmdline_mboxfolder, "sdb=s" => \$cmdline_file, ); # init commandline parser Getopt::Long::config('bundling', 'no_getopt_compat', 'no_auto_abbrev'); # process commandline options GetOptions(%opthash) or syntax_msg("error parsing options"); } my @langs = @ARGV; foreach my $l (@langs) { Mail::process($cmdline_mboxfolder, $l, $check_bts, $cmdline_msgid, $cmdline_file); } =head1 LICENSE 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. =head1 COPYRIGHT (C) 2003,2004 Tim Dijkstra 2004 Nicolas Bertolissio 2004 Martin Quinson =cut 1; dl10n-3.00/lib/0000755000000000000000000000000011544665455010025 5ustar dl10n-3.00/lib/Debian/0000755000000000000000000000000011544665455011207 5ustar dl10n-3.00/lib/Debian/Pkg/0000755000000000000000000000000011704570256011720 5ustar dl10n-3.00/lib/Debian/Pkg/Tar.pm0000644000000000000000000007376211704570256013023 0ustar #!/usr/bin/perl -w ## Copyright (C) 2001 Denis Barbier ## ## 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 2 of the License, or ## (at your option) any later version. =head1 NAME Debian::Pkg::Tar - examine tarfile contents =head1 DESCRIPTION This package is the base class for all C classes. Unlike most tar processors, this one does perform all operations in memory, but retrieves only specified files, so it should not consume too much memory if you are specific enough. =head1 METHODS =over 4 =cut package Debian::Pkg::Tar; use strict; use Carp; use Symbol; use File::Path; use File::Basename; use Debian::Pkg::Diff; =item new This is the constructor. It has a mandatory argument, which is either a tarfile, or a string containing command for a pipe creation. my $tar1 = Debian::Pkg::Tar->new("foo-0.1.tar"); my $tar2 = Debian::Pkg::Tar->new("foo-0.1.tar.gz"); my $tar3 = Debian::Pkg::Tar->new("gzip -dc foo-0.1.tar.gz |"); The last two are strictly equivalent, since this package does not know how to handle compressed files, they are gunzipped on the fly if they have a F<.gz> extension. Options can be passed in the form of a hash array; these options are currently supported: =over 6 =item C Set to 1 if you want to see lots of garbage on screen =item C This option sets default argument if C method is called without argument. =item C Sets maximum amount of memory used to store file content. Scanning is aborted and an error is reported when this amount is exceeded. =back Example: my $tar2 = Debian::Pkg::Tar->new("foo-0.1.tar.gz", debug => 1, parse_dft => 32, ); =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; my $file = shift || Carp::carp "Missing argument in ".__PACKAGE__."::new"; my $fh = Symbol::gensym(); my $self = { name => $file, handle => $fh, dir => "", wrongdir=> 0, cached => 0, offset => 0, memory => 0, maxcache => 0, patch => undef, data => { list_files => [], list_dirs => [], files => {}, dirs => {}, }, parse_last => 0, # these options can be overriden by caller _parse_dft => 0, _debug => 0, _maxmem => 0, _prepend_dir => 0, }; if ($#_ >= 0) { my %opts = @_; while (my ($key, $val) = each %opts) { $self->{"_".$key} = $val; } } bless ($self, $class); return $self; } sub _debug { my $self = shift; return unless $self->{_debug}; print STDERR __PACKAGE__." Debug: ".$_[0] . "\n"; } sub _io_open { my $self = shift; if ($self->{name} =~ m/\.gz$/) { open ($self->{handle}, "gzip -dc $self->{name} |") or Carp::carp "Unable to open $self->{name}"; } elsif ($self->{name} =~ m/\.bz2$/) { open ($self->{handle}, "bzip2 -dc $self->{name} |") or Carp::carp "Unable to open $self->{name}"; } elsif ($self->{name} =~ m/\.xz$/) { open ($self->{handle}, "xz -dc $self->{name} |") or Carp::carp "Unable to open $self->{name}"; } elsif ($self->{name} =~ m/\|/) { open ($self->{handle}, $self->{name}) or Carp::carp "Unable to execute \`$self->{name}'"; } elsif (-f $self->{name}) { open ($self->{handle}, $self->{name}) or Carp::carp "Unable to open \`$self->{name}'"; } else { Carp::carp "Do not know what to do with this argument: $self->{name}"; } $self->{offset} = 0; } sub _io_close { my $self = shift; close($self->{handle}); $self->{offset} = -1; } sub _io_read { my $self = shift; my $nbytes = shift; my $getData = shift || 0; my $ignore_eof = shift || 0; return '' if $nbytes <= 0; my $text = ''; my ($nread, $buffer); $self->_debug("Reading $nbytes bytes at offset $self->{offset}"); $self->{offset} += $nbytes; while ($nbytes > 4096) { $nbytes -= read($self->{handle}, $buffer, $nbytes) || Carp::carp "End of file found when reading \`$self->{name}'"; $text .= $buffer if $getData; } if ($nbytes > 0) { my $nread = read($self->{handle}, $buffer, $nbytes); if (not defined $nread) { Carp::carp "Failed to read \`$self->{name}': $!"; } elsif ($nread == 0) { if ($ignore_eof) { $text = undef; } else { Carp::carp "End of file found when reading \`$self->{name}'"; } } else { $text .= $buffer if $getData; } } return $text; } =item parse This is where all processing is done. It has an optional argument, which is either a subroutine reference or a number. For each file found in archive, this routine will be called with filename given as attribute, and it returns either a number or a string beginning with a colon. All other return values are discarded and treated as 0. The former gives the number of bytes of file content stored in internal cache (see below the C method), and the latter specifies a path where content is stored. Example: my $match = sub { my $file = shift; if ($file =~ m|po/.*\.po$|) { $file =~ s|/|_|g; return ':po-files/'.$file; } $file =~ m|\.c$| && return 32; return 0; }; $tar1->parse($match); This example writes on disk all files matching the Perl regular expression C, and reads in memory all C source files, but truncate them to 32 chars. When file content is retrieved via the C method, it will be immediately available if less than 32 chars are requested. Otherwise, archive will be parsed again to retrieve the desired amount of chars of the specified file. When C method's argument is a number, this is a shortcut to truncate and store all files to the desired length. There are two special cases: if this argument is missing or is null, then archive is scanned and structure is stored, but file contents are not retrieved. If this argument is -1, then files contents are kept in memory. Of course, this option should not be used on large tarballs. When C method is called the first time, an internal representation of tarfile is stored to let further parsing faster, and tarfile will be read only if result has not been cached by previous calls. =cut sub parse { my $self = shift; my $matchfiles; $self->_debug("Begin parsing"); if ($#_ >= 0) { $matchfiles = shift; } else { $matchfiles = $self->{_parse_dft} || sub { return 0; }; } # Transform argument if necessary if (ref($matchfiles) ne 'CODE') { Carp::confess "Invalid argument of ".__PACKAGE__."::parse" unless $matchfiles =~ m/^-?\d+$/; eval "\$matchfiles = sub { return $matchfiles; }"; } $self->{parse_last} = $matchfiles; if ($self->{cached}) { $self->_parse_cache($matchfiles); } else { # This tarball was never read before $self->_debug("First time parsing"); $self->_io_open(); 1 while ($self->_read_firsttime($matchfiles)); $self->_io_close(); } $self->{cached} = 1; $self->_debug("End parsing"); $self->_debug("Number of chars in cache: ".$self->get_max_memory()); } sub _read_firsttime { my $self = shift; my $matchfiles = shift; my ($block, $data, $maxlength, $numbytes, $offset); my ($name, $type, $size) = $self->_read_header(0) or return 0; my $path = ''; $name = $self->{dir}."/".$name if $self->{_prepend_dir} && $self->{dir} ne ''; $offset = $self->{offset}; if ($type eq "file") { $maxlength = &$matchfiles($name) || 0; if ($maxlength =~ s/^://) { $path = $maxlength; $maxlength = -1; } elsif ($maxlength !~ m/^-?[0-9]+$/) { $maxlength = 0; } $maxlength = $size if $maxlength == -1; $numbytes = ($size > $maxlength ? $maxlength : $size); $self->{memory} += $numbytes if $path eq ''; # Abort if memory needed is too large if ($self->{_maxmem} > 0) { Carp::carp "Not enough memory: maximum set to $self->{_maxmem}, and at least $self->{memory} needed" if $self->{memory} > $self->{_maxmem}; } $data = $self->_io_read($numbytes, 1); # Always read in full 512 byte blocks $block = ($size & 0x01ff) ? ($size & ~0x01ff) + 512 : $size; $self->_io_read($block - $numbytes) if $numbytes < $block; # Store information push(@{$self->{data}->{list_files}}, $name); if ( ($path ne '') and (! -e $path)) { # If a file already exist, it is not overwritten # When multiple archives are extracted, they shall # be extracted in reverse order. my $dir = File::Basename::dirname($path); File::Path::mkpath($dir, 0, 0755); open(DISK, "> ".$path) || warn "Unable to write to $path\n"; print DISK $data; close(DISK); $data = ''; } $self->{data}->{files}->{$name} = { offset => $offset, size => $size, data => $data, read => $numbytes, path => $path, dchars => 0, patch => 0, }; $self->_debug(" Type : file"); $self->_debug(" Size : $size"); $self->_debug(" Offset : $offset"); $self->_debug(" Path : $path") if $path ne ''; } elsif ($type eq "dir") { $name =~ s|/$||; push (@{$self->{data}->{list_dirs}}, $name); $self->{data}->{dirs}->{$name} = 1; $self->_debug(" Type : directory"); $self->_debug(" Offset : $offset"); } elsif ($type eq 'g' || $type eq 'x') { # Always read in full 512 byte blocks $self->_debug(" Type : pax attributes"); $self->_debug(" Offset : $offset"); if ($size & 0x01ff) { $size = ($size & ~0x01ff) + 512; $self->_io_read($size); } } else { $self->_debug(" Type : unknown ($type)"); } # This entry is not the last one return 1; } sub _read_header { my $self = shift; my $cont = shift; # 1 when reading long filenames, 0 otherwise # Read header my $head = $self->_io_read(512, 1, 1); # Some tar files have no trailing null block if ( (not defined $head) or ($head eq "\0" x 512)) { $self->_debug("EOF detected"); return; } # Unpack it my ($name, $mode, $uid, $gid, $size, $mtime, $chksum, $type, $linkname, $magic, $version, $uname, $gname, $devmajor, $devminor, $prefix) = unpack ("A100 A8 A8 A8 A12 A12 A8 A1 A100 A6 A2 A32 A32 A8 A8 A155 x12", $head); if ($name eq '') { $self->_debug("Missing filename, assuming it is EOF"); return; } $size = oct $size; $chksum = oct $chksum; # What to do with these attributes? return ($name, $type, $size) if ($type eq 'g' || $type eq 'x'); # Calculate checksum substr ($head, 148, 8) = " "; # http://www.gnu.org/software/tar/manual/tar.html#SEC139 # "SunOS and HP-UX tar fail to accept archives created using GNU tar # and containing non-ASCII file names, that is, file names having # characters with the eight bit set, because they use signed checksums, # while GNU tar uses unsigned checksums while creating archives, as per # POSIX standards. On reading, GNU tar computes both checksums and # accept any." # The regular checksum is unpack ("%16C*", $head), but we also accept # unpack ("%16c*", $head) Carp::carp "$self->{name}:$name: checksum error.\n" if ( (unpack ("%16C*", $head) != $chksum) and (unpack ("%16c*", $head) != $chksum)); # Handle long filename (>100 chars) if ($prefix ne "") { # POSIX way $name = $prefix."/".$name; } elsif ($name eq "././\@LongLink" && $type eq "L") { # GNU way my $realname = $self->_io_read($size, 1) || Carp::carp "End of file found when reading \`$self->{name}'"; $self->_io_read(($size & ~0x01ff) + 512 - $size) if ($size & 0x01ff); ($name, $type, $size) = $self->_read_header(1) or return 0; $name = $realname; } $self->_debug("Found $name"); $type = "file" if $type eq ""; if ($type =~ m/^\d/) { if ($type == 0) { $type = "file"; } elsif ($type == 5) { $type = "dir"; } else { $type = "unknown"; } } $name .= '/' if $type eq 'dir' && $name !~ m#/#; if ($name =~ s|^((\.\/)?[^/]+)/||) { if ($self->{wrongdir} == 0 && $self->{_prepend_dir} == 0) { if ($self->{dir} ne "" && $self->{dir} ne $1) { $name = $1 . '/' . $name; $self->{wrongdir} = 1; $self->_debug("Warning: unable to determine top-level directory in $self->{name}, assuming there is no root directory"); # Adapt already scanned files and # directories $self->_prepend_dir($self->{dir}); $self->{dir} = ''; } else { $self->{dir} = $1; } } else { $name = $1 . '/' . $name; } } else { if ($self->{wrongdir} == 0) { $self->{wrongdir} = 1; $self->_debug("Warning: unable to determine top-level directory in $self->{name}, assuming there is no root directory"); $self->_prepend_dir($self->{dir}) if $self->{dir} ne ''; } } # Fix broken archives $type = "dir" if $name =~ m|/$| and $type eq "file" and !$cont; return ($name, $type, $size); } sub _prepend_dir { my $self = shift; my $dir = shift; foreach (keys %{$self->{data}->{files}}) { $self->{data}->{files}->{$dir.'/'.$_} = $self->{data}->{files}->{$_}; delete $self->{data}->{files}->{$_}; } foreach (keys %{$self->{data}->{dirs}}) { $self->{data}->{dirs}->{$dir.'/'.$_} = $self->{data}->{dirs}->{$_}; delete $self->{data}->{dirs}->{$_}; } my @list_files = (); foreach (@{$self->{data}->{list_files}}) { push(@list_files, $dir.'/'.$_); } $self->{data}->{list_files} = [@list_files]; my @list_dirs = (); foreach (@{$self->{data}->{list_dirs}}) { push(@list_dirs, $dir.'/'.$_); } $self->{data}->{list_dirs} = [@list_dirs]; } sub _parse_cache { my $self = shift; my $matchfiles = shift; my ($name, $offset, $numbytes, $maxlength, $block, $path); my ($filesize, $fileoffset, $text); $self->_debug("Checking in memory representation"); $self->_io_open(); foreach $name (@{$self->{data}->{list_files}}) { $maxlength = &$matchfiles($name) || 0; $path = ''; if ($maxlength =~ s/^://) { $path = $maxlength; $fileoffset = $self->{data}->{files}->{$name}->{offset}; $filesize = $self->{data}->{files}->{$name}->{size}; $maxlength = $filesize; unless (-r $path) { $maxlength = $filesize; if ($self->{data}->{files}->{$name}->{patch} || $self->{data}->{files}->{$name}->{read} < $maxlength) { $self->_io_read($fileoffset - $self->{offset}); $text = $self->_io_read($maxlength, 1); $self->{offset} = $fileoffset + $maxlength; } else { $text = $self->{data}->{files}->{$name}->{data}; } $self->{data}->{files}->{$name}->{patch} = 1 if defined $self->{patch} && $self->{patch}->{data}->{files}->{$name}; $text = $self->{patch}->apply_patch($name, $text) if $self->{data}->{files}->{$name}->{patch}; my $dir = File::Basename::dirname($path); File::Path::mkpath($dir, 0, 0755); open(DISK, "> ".$path) || warn "Unable to write to $path\n"; print DISK $text; close(DISK); $self->{data}->{files}->{$name}->{data} = ''; $self->{data}->{files}->{$name}->{read} = 0; } next; } elsif ($maxlength !~ m/^-?[0-9]+$/) { $maxlength = 0; } next unless $maxlength == -1 || $maxlength =~ m/^[0-9]+$/; # Look if result is cached $fileoffset = $self->{data}->{files}->{$name}->{offset}; $filesize = $self->{data}->{files}->{$name}->{size}; $maxlength = $filesize if $maxlength == -1 || $maxlength > $filesize; # File content is in cache next if $self->{data}->{files}->{$name}->{read} >= $maxlength; # New file added by patch next if $self->{data}->{files}->{$name}->{offset} == -1; $numbytes = ($filesize > $maxlength ? $maxlength : $filesize); # Abort if memory needed is too large $self->{memory} += $numbytes - $self->{data}->{files}->{$name}->{read} if $path eq ''; if ($self->{_maxmem} > 0) { Carp::carp "Not enough memory: maximum set to $self->{_maxmem}, and at least $self->{memory} needed" if $self->{memory} > $self->{_maxmem}; } $self->_debug("Found $name at offset $fileoffset"); $self->_io_read($fileoffset - $self->{offset}); $self->{offset} = $fileoffset; $self->{data}->{files}->{$name}->{data} = $self->_io_read($numbytes, $maxlength); $self->{data}->{files}->{$name}->{read} = $numbytes; $self->{data}->{files}->{$name}->{patch} = 1 if defined $self->{patch} && $self->{patch}->{data}->{files}->{$name}; } $self->_io_close(); } =item list_dirs Return the list of directories. my @listdirs = $tar1->list_dirs(); =cut sub list_dirs { my $self = shift; $self->parse() unless $self->{cached}; return @{$self->{data}->{list_dirs}}; } =item list_files Return the list of files. my @listfiles = $tar1->list_files(); =cut sub list_files { my $self = shift; $self->parse() unless $self->{cached}; return @{$self->{data}->{list_files}}; } =item file_exists Return 1 if argument is a file found in package, 0 otherwise. if ($tar1->file_exists("debian/template")) { print "Hey, this package uses Debconf!\n"; } =cut sub file_exists { my $self = shift; $self->parse() unless $self->{cached}; return defined($self->{data}->{files}->{$_[0]}) ? 1 : 0; } =item file_matches Return the list of files matching argument, which is a Perl regular expression. my @c = $self->file_matches("^c"); =cut sub file_matches { my $self = shift; my $expr = shift; my @found = (); my $match = sub { my $file = shift; $file =~ m/$expr/; }; foreach ($self->list_files()) { push (@found, $_) if &$match($_); } return @found; } =item file_content Return the content of a file if it resides in archive. my $control = $self->file_content("debian/control"); An optional second argument is the number of bytes to read. =cut sub file_content { my $self = shift; my $file = shift; my $length = shift || -1; $self->_debug("Retrieve content of file $file"); unless ($self->file_exists($file)) { Carp::carp "File \`$file' not found in archive"; return; } return $self->_file_content_patch($file, $length) if defined $self->{patch} && $self->{patch}->{data}->{files}->{$file}; if ($self->{data}->{files}->{$file}->{path} ne '') { local $/ = undef; open(DISK, "< ".$self->{data}->{files}->{$file}->{path}) || warn "Unable to read from ". $self->{data}->{files}->{$file}->{path}."\n"; my $text = ; close(DISK); return $text; } $length = $self->{data}->{files}->{$file}->{size} if $length == -1 || $length > $self->{data}->{files}->{$file}->{size}; return substr($self->{data}->{files}->{$file}->{data}, 0, $length) if $self->{data}->{files}->{$file}->{read} >= $length; $self->_io_open() unless $self->{offset} >= 0 && $self->{data}->{files}->{$file}->{offset} >= $self->{offset}; $self->_io_read($self->{data}->{files}->{$file}->{offset} - $self->{offset}); $self->_debug("Read $length bytes of $file"); $self->{data}->{files}->{$file}->{data} = $self->_io_read($length, 1); return $self->{data}->{files}->{$file}->{data}; } sub _file_content_patch { my $self = shift; my $file = shift; my $length = shift || -1; my ($text, $strlen); $self->_debug("Retrieve content of file $file with patches applied"); unless ($self->file_exists($file)) { Carp::carp "File \`$file' not found in archive"; return; } if ($self->{data}->{files}->{$file}->{path} ne '') { local $/ = undef; open(DISK, "< ".$self->{data}->{files}->{$file}->{path}) || warn "Unable to read from ". $self->{data}->{files}->{$file}->{path}."\n"; $text = ; close(DISK); # We read text, but do not know yet if it has to be # patched } if ($self->{data}->{files}->{$file}->{patch}) { # File already patched in cache # New file not in tarball return $self->{patch}->apply_patch($file, $text) if $self->{data}->{files}->{$file}->{offset} == -1; $length = $self->{data}->{files}->{$file}->{size} + $self->{data}->{files}->{$file}->{dchars} if $length == -1 || $length > $self->{data}->{files}->{$file}->{size} + $self->{data}->{files}->{$file}->{dchars}; return $text if $self->{data}->{files}->{$file}->{path} ne ''; return substr($self->{data}->{files}->{$file}->{data}, 0, $length) if $self->{data}->{files}->{$file}->{read} >= $length; } if ($self->{data}->{files}->{$file}->{path} ne '') { # Original file has been stored on disk, it must # be patched and overwritten $text = $self->{patch}->apply_patch($file, $text); open(DISK, "> ".$self->{data}->{files}->{$file}->{path}) || warn "Unable to write to ". $self->{data}->{files}->{$file}->{path}."\n"; print DISK $text; close(DISK); $self->{data}->{files}->{$file}->{patch} = 1; return $text; } # Read the whole source file $strlen = $self->{data}->{files}->{$file}->{size}; $self->_io_open() unless $self->{offset} >= 0 && $self->{data}->{files}->{$file}->{offset} >= $self->{offset}; $self->_io_read($self->{data}->{files}->{$file}->{offset} - $self->{offset}); $self->_debug("Read $strlen bytes of $file"); $text = $self->_io_read($strlen, 1); $text = $self->{patch}->apply_patch($file, $text); substr($text, $length) = '' if length($text) > $length && $length != -1; $self->{data}->{files}->{$file}->{data} = $text; $self->{data}->{files}->{$file}->{read} = length($text); $self->{data}->{files}->{$file}->{patch} = 1; return $text; } =item bind_patch Bind current tarball to a patch, so that all files are retrieved as if patch was applied after extracting files from tarball. $self->bind_patch("foo-0.1.diff.gz"); my $text = $self->file_content("debian/control"); This routine accepts the same optional arguments as Cnew>. =cut sub bind_patch { my $self = shift; my $file = shift; Carp::carp "Another patch is already bound" if defined $self->{patch}; $self->parse(0) unless $self->{cached}; $self->_debug("Apply patch file $file"); my %opts = (); %opts = @_ if $#_ >= 0; $opts{parse_dft} ||= $self->{parse_last}; $self->{patch} = Debian::Pkg::Diff->new($file, %opts); $self->{patch}->parse(); foreach ($self->{patch}->list_files()) { $self->{data}->{files}->{$_}->{dchars} = $self->{patch}->{data}->{files}->{$_}->{dchars}; } foreach ($self->{patch}->list_new_files()) { $self->_debug("New file added to archive: $_"); my $data = $self->{patch}->{data}->{files}->{$_}->{data}; $data =~ s/^\+//mg; $self->{data}->{files}->{$_} = { offset => -1, size => 0, data => $data, read => length($data), path => '', dchars => length($data), patch => 1, }; push (@{$self->{data}->{list_files}}, $_); } } =item get_memory Get number of characters currently stored in cache. print "Memory used: ".$tar1->get_memory()."\n"; =cut sub get_memory { return $_[0]->{memory}; } =item get_max_memory Get maximum number of characters stored in this object during its timelife. print "Max memory used: ".$tar1->get_max_memory()."\n"; =cut sub get_max_memory { my $self = shift; $self->{maxcache} = $self->{memory} if $self->{maxcache} < $self->{memory}; return $self->{maxcache}; } =item free Free memory by removing all previous remembered data. $tar1->free(); =cut sub free { my $self = shift; return unless $self->{cached}; $self->{maxcache} = $self->{memory} if $self->{maxcache} < $self->{memory}; $self->_debug("Free memory"); foreach (@{$self->{data}->{list_files}}) { $self->{data}->{files}->{$_}->{read} = 0; $self->{data}->{files}->{$_}->{data} = ''; } $self->{memory} = 0; } =back =head1 AUTHOR Copyright (C) 2001 Denis Barbier 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 2 of the License, or (at your option) any later version. =cut 1; dl10n-3.00/lib/Debian/Pkg/Diff.pm0000644000000000000000000005116111544665455013142 0ustar #!/usr/bin/perl -w ## Copyright (C) 2001 Denis Barbier ## ## 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 2 of the License, or ## (at your option) any later version. =head1 NAME Debian::Pkg::Diff - examine and apply patch =head1 DESCRIPTION This package reads a patch file in memory, and apply hunks on demand. =head1 METHODS =over 4 =cut package Debian::Pkg::Diff; use strict; use Carp; use Symbol; =item new This is the constructor. It has a mandatory argument, which is either a tarfile, or a string containing command for a pipe creation. my $diff1 = Debian::Pkg::Diff->new("foo-0.1.diff"); my $diff2 = Debian::Pkg::Diff->new("foo-0.1.diff.gz"); my $diff3 = Debian::Pkg::Diff->new("gzip -dc foo-0.1.diff.gz |"); The last two are strictly equivalent, since this package does not know how to handle compressed files, they are gunzipped on the fly if they have a F<.gz> extension. Options can be passed in the form of a hash array; these options are currently supported: =over 6 =item C Set to 1 if you want to see lots of garbage on screen =item C This option sets default argument if C method is called without argument. =item C Sets maximum amount of memory used to store file content. Scanning is aborted and an error is reported when this amount is exceeded. =item Path specifications A patch file typically contains line like these ones: --- foo-0.4.orig/Makefile +++ foo-0.4/Makefile --- foo-0.4/Makefile +++ foo-0.4.new/Makefile --- foo-0.4/Makefile.orig +++ foo-0.4/Makefile So a general representation for all such cases is --- foo-0.4/Makefile +++ foo-0.4/Makefile Six other arguments of the C method can be specified, namely C, C, C, C, C and C, to treat all cases above. =back Example: my $diff2 = Debian::Pkg::Diff->new("foo-0.1.diff.gz", olddirsuffix => '.orig', parse_dft => -1, ); =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; my $file = shift || Carp::croak "Missing argument in ".__PACKAGE__."::new"; my $fh = Symbol::gensym(); my $self = { name => $file, handle => $fh, cached => 0, offset => 0, memory => 0, maxcache => 0, curr_line => '', data => { list_files => [], list_new_files => [], files => {}, new_files => {}, }, # these options can be overriden by caller _parse_dft => 0, _debug => 0, _maxmem => 0, _olddirprefix => '', _olddirsuffix => '', _oldfilesuffix => '', _newdirprefix => '', _newdirsuffix => '', _newfilesuffix => '', }; if ($#_ >= 0) { my %opts = @_; while (my ($key, $val) = each %opts) { $self->{"_".$key} = $val; } } # Special characters in these variables must be escaped $self->{_olddirprefix} = quotemeta($self->{_olddirprefix}); $self->{_olddirsuffix} = quotemeta($self->{_olddirsuffix}); $self->{_oldfilesuffix} = quotemeta($self->{_oldfilesuffix}); $self->{_newdirprefix} = quotemeta($self->{_newdirprefix}); $self->{_newdirsuffix} = quotemeta($self->{_newdirsuffix}); $self->{_newfilesuffix} = quotemeta($self->{_newfilesuffix}); bless ($self, $class); return $self; } sub _debug { my $self = shift; print STDERR __PACKAGE__." Debug: ".$_[0] . "\n" if $self->{_debug}; } sub _io_open { my $self = shift; if ($self->{name} =~ m/\.gz$/) { open ($self->{handle}, "gzip -dc $self->{name} |") or Carp::croak "Unable to open $self->{name}"; } elsif ($self->{name} =~ m/\.bz2$/) { open ($self->{handle}, "bzip2 -dc $self->{name} |") or Carp::croak "Unable to open $self->{name}"; } elsif ($self->{name} =~ m/\|/) { open ($self->{handle}, $self->{name}) or Carp::croak "Unable to execute \`$self->{name}'"; } elsif (-f $self->{name}) { open ($self->{handle}, $self->{name}) or Carp::croak "Unable to open \`$self->{name}'"; } else { Carp::croak "Do not know what to do with this argument: $self->{name}"; } $self->{offset} = 0; } sub _io_close { close($_[0]->{handle}); } sub _io_read_lines { my $self = shift; my $nlines = shift; my $getData = shift || 0; $self->_debug("Reading $nlines lines"); return '' if $nlines <= 0; my $fh = $self->{handle}; my $text = ''; while ($nlines) { $text .= $self->{curr_line} if $getData; $self->{offset} += length($self->{curr_line}); $self->{curr_line} = <$fh>; last if !defined($self->{curr_line}); $nlines --; } return $text; } sub _io_read { my $self = shift; my $nbytes = shift; my $getData = shift || 0; return '' if $nbytes <= 0; my $text = ''; my $fh = $self->{handle}; my ($nread, $buffer); $self->_debug("Reading $nbytes bytes at offset $self->{offset}"); $self->{offset} += $nbytes; while ($nbytes > 4096) { $nbytes -= read($fh, $buffer, $nbytes) || Carp::croak "End of file found when reading \`$self->{name}'"; $text .= $buffer if $getData; } if ($nbytes > 0) { read($fh, $buffer, $nbytes) || Carp::croak "End of file found when reading \`$self->{name}'"; $text .= $buffer if $getData; } return $text; } =item parse Parse patch and store informations in memory. See the C documentation for a detailed description of this function, but note that in most cases, -1 is the argument to pass to it. =cut sub parse { my $self = shift; my $matchfiles; my $fh = $self->{handle}; $self->_debug("Begin parsing"); if ($#_ >= 0) { $matchfiles = shift; } else { $matchfiles = $self->{_parse_dft} || sub { return 0; }; } # Transform argument when necessary if (ref($matchfiles) ne 'CODE') { Carp::confess "Invalid argument of ".__PACKAGE__."::parse" unless $matchfiles =~ m/^-?\d+$/; eval "\$matchfiles = sub { return $matchfiles; }"; } $self->{curr_line} = ''; if ($self->{cached}) { $self->_parse_cache($matchfiles); } else { # This patch was never read before $self->_debug("First time parsing"); $self->_io_open(); # Initialize $self->{curr_line} $self->{curr_line} = <$fh>; 1 while ($self->_read_firsttime($matchfiles)); $self->_io_close(); } $self->{cached} = 1; $self->_debug("End parsing"); } sub _read_firsttime { my $self = shift; my $matchfiles = shift; return 0 if !defined($self->{curr_line}); my $name = $self->_read_header() or return 0; my $maxlength = &$matchfiles($name); $self->_read_patches($name, $maxlength); # This entry is not the last one return 1; } sub _read_header { my $self = shift; my ($dir, $file); # Read header Carp::croak "Malformed diff: line does not begin with ---:\n$self->{curr_line}\n" unless $self->{curr_line} =~ m|^--- ([^/]+)$self->{_olddirsuffix}/([^\t\n]+)$self->{_oldfilesuffix}|; ($dir, $file) = ($1, $2); my $fh = $self->{handle}; $self->{offset} += length($self->{curr_line}); $self->{curr_line} = <$fh>; Carp::croak "Malformed diff: found\n$self->{curr_line}when expecting\n+++ $self->{_newdirprefix}$dir$self->{_newdirsuffix}/$file$self->{_newfilesuffix}" unless $self->{curr_line} =~ m#^\+\+\+ $self->{_newdirprefix}\Q$dir\E$self->{_newdirsuffix}/\Q$file\E$self->{_newfilesuffix}\s*(\b|$)#; # The \* above allows patch blocks to end with spaces or tabulations # It might not be valid, but handwritten patches tends to contain such # diff header (removal of date) $self->{offset} += length($self->{curr_line}); $self->{curr_line} = <$fh>; return $file; } sub _read_patches { my $self = shift; my $name = shift; my $nbytes = shift; my $text = ''; my @patch_list = (); my ($offset, $nlines, $chars, $dchars, $entry); $nlines = 0; $dchars = 0; $offset = $self->{offset}; while (1) { ($entry, $chars) = $self->_read_chunk(); last unless ref($entry) eq 'HASH'; $text .= $entry->{data} if $nbytes != 0; $nlines += $entry->{nlines}; $dchars += $chars; push (@patch_list, $entry); last if !defined($self->{curr_line}) or $self->{curr_line} =~ m/^--- /; } return if $nbytes == 0; if ($nbytes > 0 && $nbytes < length($text)) { substr($text, $nbytes) = ''; } # Store information push(@{$self->{data}->{list_files}}, $name) unless $self->{cached}; $self->{data}->{files}->{$name} = { offset => $offset, size => $self->{offset} - $offset, data => $text, read => length($text), dchars => $dchars, patch_list => \@patch_list, }; if ($self->{data}->{files}->{$name}->{patch_list}->[0]->{oldfirstline} eq 0 && !$self->{cached}) { push(@{$self->{data}->{list_new_files}}, $name); $self->{data}->{new_files}->{$name} = 1; } $self->_debug(" Name : ".$name); $self->_debug(" Type : file"); $self->_debug(" Size : ".($self->{offset} - $offset)); $self->_debug(" Read : ".length($text)); $self->_debug(" Offset : $offset"); } sub _read_chunk { my $self = shift; my ($nread, $buffer, $size, $line, %entry); my ($nlines, $nlinesold, $nlinesnew, $nchars); $line = $self->{curr_line}; chomp $line; $self->_debug("Chunk found: ".$line); if ($line =~ m/^\@\@ -(\d+)(?:,(\d+))? \+(\d+)(?:,(\d+))? \@\@/) { %entry = ( oldfirstline => $1, oldnblines => (defined($2) ? $2 : 1), newfirstline => $3, newnblines => (defined($4) ? $4 : 1), ); } else { Carp::croak "Malformed patch, first line is:\n$self->{curr_line}" } my $text = ''; $nlines = 0; $nlinesold = 0; $nlinesnew = 0; $nchars = 0; while ($nlinesold != $entry{oldnblines} || $nlinesnew != $entry{newnblines}) { $self->_io_read_lines(1, 1); if (defined($self->{curr_line}) && $self->{curr_line} eq "\\ No newline at end of file\n") { $self->{curr_line} = ''; next; } last if !defined($self->{curr_line}) or $self->{curr_line} =~ m/^\@\@ /; $text .= $self->{curr_line}; if ($self->{curr_line} =~ m/^-/) { $nlinesold ++; $nchars -= length($self->{curr_line}) - 1; } elsif ($self->{curr_line} =~ m/^\+/) { $nlinesnew ++; $nchars += length($self->{curr_line}) - 1; } else { $nlinesold ++; $nlinesnew ++; } $nlines ++; }; $self->_io_read_lines(1, 1) if defined($self->{curr_line}) && $self->{curr_line} !~ m/^\@\@ /; $self->_io_read_lines(1, 1) if defined($self->{curr_line}) && $self->{curr_line} eq "\\ No newline at end of file\n"; $entry{data} = $text; $entry{nlines} = $nlines; return (\%entry, $nchars); } sub _parse_cache { my $self = shift; my $matchfiles = shift; my ($name, $offset, $numbytes, $maxlength, $block); my ($filesize, $fileoffset); $self->_debug("Checking in memory representation"); $self->{offset} = 0; foreach $name (@{$self->{data}->{list_files}}) { $maxlength = &$matchfiles($name); next if $maxlength == 0; # Look if result is cached $fileoffset = $self->{data}->{files}->{$name}->{offset}; $filesize = $self->{data}->{files}->{$name}->{size}; $maxlength = $filesize if $maxlength == -1 || $maxlength > $filesize; next if $self->{data}->{files}->{$name}->{read} >= $maxlength; $numbytes = ($filesize > $maxlength ? $maxlength : $filesize); # Abort if memory needed is too large $self->{memory} += $numbytes - $self->{data}->{files}->{$name}->{read}; if ($self->{_maxmem} > 0) { Carp::croak "Not enough memory: maximum set to $self->{_maxmem}, and at least $self->{memory} needed" if $self->{memory} > $self->{_maxmem}; } # Open filehandle if it has not been done before $self->_io_open() unless $self->{offset} > 0; $self->_debug("Found $name at offset $fileoffset"); $self->_io_read($fileoffset - $self->{offset}); $self->{offset} = $fileoffset; # Read next line to initialize $self->{curr_line} $self->{curr_line} = ''; $self->_io_read_lines(1); $self->_read_patches($name, $numbytes); $self->{offset} += length($self->{curr_line}) if defined($self->{curr_line}); } $self->_io_close() if $self->{offset} > 0; } =item list_files Return the list of files patched. my @listfiles = $diff1->list_files(); =cut sub list_files { my $self = shift; $self->parse() unless $self->{cached}; return @{$self->{data}->{list_files}}; } =item list_new_files Return the list of files which are added by this patch. my @newfiles = $diff1->list_new_files(); =cut sub list_new_files { my $self = shift; $self->parse() unless $self->{cached}; return @{$self->{data}->{list_new_files}}; } =item is_file_patched Return 1 if argument is a file found in patch and 0 otherwise. if ($diff1->is_file_patched("configure.in")) { print "File configure.in found in patch\n"; } =cut sub is_file_patched { my $self = shift; $self->parse() unless $self->{cached}; return defined($self->{data}->{files}->{$_[0]}) ? 1 : 0; } =item patch_file_matches Return the list of files being patched and matching argument, which is a Perl regular expression. my @c = $self->patch_file_matches("^c"); =cut sub patch_file_matches { my $self = shift; my $expr = shift; my @found = (); my $match = sub { my $file = shift; $file =~ m/$expr/; }; foreach ($self->list_files()) { push (@found, $_) if &$match($_); } return @found; } =item apply_patch Given a text, returns patched version against given file. $patched = $diff1->apply_patch("src/main.c", $text); =cut sub apply_patch { my $self = shift; my $name = shift; my $text = shift || ''; $self->_debug("Applying patch to file $name"); my $match = sub { my $file = shift; $file eq $name && return -1; }; $self->parse($match) unless $self->{cached} || $self->{data}->{files}->{read} == $self->{data}->{files}->{size}; if (!defined($self->{data}->{files}->{$name})) { Carp::carp "File $name does not appear in patch"; return $text; } if ($self->{data}->{files}->{$name}->{patch_list}->[0]->{oldfirstline} == 0) { # Special case, this is a new file Carp::carp "In ".__PACKAGE__."::apply_patch, patch new file with non-empty text" if $text ne ''; $text = $self->{data}->{files}->{$name}->{patch_list}->[0]->{data}; $text =~ s/^\+//mg; return $text; } else { # 3rd argument is to prevent stripping of trailing # newlines my @out = split(/\n/, $text, -1); pop(@out) if $text =~ m/\n$/s; foreach my $p (@{$self->{data}->{files}->{$name}->{patch_list}}) { my @patch = split(/\n/, $p->{data}, -1); pop(@patch) if $p->{data} =~ m/\n$/s; my @new = (); my $begin = $p->{newfirstline} - 1; my $length = $p->{oldnblines}; my $old = $begin - 1; foreach (@patch) { if (s/^ //) { $old ++; Carp::carp __PACKAGE__."::apply_patch invoked on non-matching text on file $name near line $old\n" unless defined($out[$old]) && $_ eq $out[$old]; push @new, $_; } elsif (s/^-//) { $old ++; Carp::carp __PACKAGE__."::apply_patch invoked on non-matching text on file $name near line $old\n" unless defined($out[$old]) && $_ eq $out[$old]; } elsif (s/^\+//) { push @new, $_; } else { Carp::carp __PACKAGE__."::apply_patch invoked on non-matching text on file $name near line $old\n"; } } splice @out, $begin, $length, @new; } $text = join("\n", @out)."\n"; } return $text; } =item get_memory Get number of characters currently stored in cache print "Memory used: ".$diff1->get_memory()."\n"; =cut sub get_memory { return $_[0]->{memory}; } =item get_max_memory Get maximum number of characters stored in this object during its timelife print "Max memory used: ".$diff1->get_max_memory()."\n"; =cut sub get_max_memory { my $self = shift; $self->{maxcache} = $self->{memory} if $self->{maxcache} < $self->{memory}; return $self->{maxcache}; } =item free Free memory by removing all previous remembered data. $diff1->free(); =cut sub free { my $self = shift; return unless $self->{cached}; $self->{maxcache} = $self->{memory} if $self->{maxcache} < $self->{memory}; $self->_debug("Free memory"); foreach (@{$self->{data}->{list_files}}) { $self->{data}->{files}->{$_}->{read} = 0; $self->{data}->{files}->{$_}->{data} = ''; } $self->{memory} = 0; } =back =head1 AUTHOR Copyright (C) 2001 Denis Barbier 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 2 of the License, or (at your option) any later version. =cut 1; dl10n-3.00/lib/Debian/Pkg/DebSrc.pm0000644000000000000000000001465611704570256013434 0ustar #!/usr/bin/perl -w ## Copyright (C) 2001 Denis Barbier ## ## 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 2 of the License, or ## (at your option) any later version. =head1 NAME Debian::Pkg::DebSrc - extract contents from Debian source package =head1 SYNOPSIS use Debian::Pkg::DebSrc; my $deb = Debian::Pkg::DebSrc->new("/path/to/foo_0.1-1.dsc"); my @list = $deb->list_files(); my $body = $deb->file_content("debian/control"); =head1 DESCRIPTION This module extracts informations and files from a Debian source package. It is built upon the C module, see its documentation for further details on available methods. =head1 METHODS =over 4 =cut package Debian::Pkg::DebSrc; use Debian::Pkg::Tar; @ISA = ("Debian::Pkg::Tar"); use strict; use Carp; =item new This is the constructor. my $deb = Debian::Pkg::DebSrc->new("/path/to/foo_0.1-1.dsc"); Basically, C file is parsed to read tarball and patch file names, then Cnew> is called with tarball filename being first argument. When a patch file is found, Cbind_patch> method is invoked. Optional arguments with a C prefix are passed along to the latter (with the prefix removed), whereas other arguments are passed along to the former. my $deb = Debian::Pkg::DebSrc->new("/path/to/foo_0.1-1.dsc", parse_dft => 0, patch_parse_dft => -1, ); is almost equivalent to my $deb = Debian::Pkg::Tar->new("/path/to/foo_0.1.orig.tar.gz", parse_dft => 0, ); $deb->bind_patch( parse_dft => -1 ); $deb->parse(); When tarball or patch file is required but does not exist, the C method returns C after printing a warning. =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; my $file = shift; my $dir = $file; $dir =~ s|/+[^/]*$||; my $origtargz = ''; my $v3targz = ''; my $diffgz = ''; open(DSC, "< ".$file) or return undef; while () { last if m/^Files:/; } while () { chomp; last unless s/^ \S* \S* //; if (m/\.debian.tar\.(gz|bz2|xz)$/) { $v3targz = $dir . '/' . $_; unless (-f $v3targz) { warn "$v3targz: No such file\n"; return undef; } } elsif (m/\.tar\.(gz|bz2|xz)$/) { $origtargz = $dir . '/' . $_; unless (-f $origtargz) { warn "$origtargz: No such file\n"; return undef; } } elsif (m/\.diff\.gz$/) { $diffgz = $dir . '/' . $_; unless (-f $diffgz) { warn "$diffgz No such file\n"; return undef; } } } close(DSC); if ($origtargz eq '') { warn "No tarball\n"; return undef; } my $self = $class->SUPER::new("$origtargz", @_); bless ($self, $class); # Apply the v3 tarball if found if ($v3targz) { $self->{v3} = Debian::Pkg::Tar->new("$v3targz", @_, prepend_dir=>1); $self->{v3}->parse(); } # Apply patch if found my %patch_opts = (); if ($#_ >= 0) { my %opts = @_; foreach (keys %opts) { next unless s/^patch_//; $patch_opts{$_} = $opts{'patch_'.$_}; } } $patch_opts{olddirsuffix} = '.orig' if !defined($patch_opts{olddirsuffix}); $self->bind_patch($diffgz, %patch_opts) if $diffgz ne ''; $self->parse(); return $self; } =item get_tar_name Returns the full qualified name of tarball my $tarfile = $deb->get_tar_name(); =cut sub get_tar_name { my $self = shift; return $self->{name}; } =item get_diff_name Returns the full qualified name of the diff file, or empty string if it does not exist. my $patchname = $deb->get_diff_name(); =cut sub get_diff_name { my $self = shift; return (defined($self->{patch}) ? $self->{patch}->{name} : ''); } =item file_matches Check files matching in origtargz and v3targz =cut sub file_matches { my $self = shift; my $expr = shift; my @found = (); @found = $self->SUPER::file_matches($expr); if ($self->{v3}) { my %found; foreach (@found) { $found{$_} = 1 } my @found2 = $self->{v3}->file_matches($expr); foreach (@found2) { push @found, $_ unless $found{$_}; } } return @found; } =item file_exists Check if a given file exists in origtargz or v3targz =cut sub file_exists { my $self = shift; my $file = shift; return ( $self->SUPER::file_exists($file) or (defined $self->{v3} and $self->{v3}->file_exists($file))); } =item file_content Get the content of a file from origtargz or v3targz =cut sub file_content { my $self = shift; my $file = shift; my $length = shift || -1; if ( (defined $self->{v3}) and $self->{v3}->file_exists($file)) { return $self->{v3}->file_content($file, $length); } return $self->SUPER::file_content($file, $length); } =back =head1 LIMITATIONS It is a pain to retrieve content of Debian packages when in dbs format, since C must be called to apply patches on upstream tarball. It does not make much sense to use an in-memory representation in such a case, so this module will surely not try to ease parsing such packages. =head1 AUTHOR Copyright (C) 2001 Denis Barbier 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 2 of the License, or (at your option) any later version. =cut 1; dl10n-3.00/lib/Debian/L10n/0000755000000000000000000000000011704570256011711 5ustar dl10n-3.00/lib/Debian/L10n/Mail.pm0000644000000000000000000001037711704570256013141 0ustar package Mail; use strict; use utf8; =head1 NAME dl10n-mail -- crawl translator mails (and BTS) for status updates =head1 SYNOPSIS dl10n-mail [options] mailbox lang+ =head1 DESCRIPTION =cut use Debian::L10n::Db; use Debian::L10n::BTS; use Debian::L10n::Utils; use Mail::Box::Mbox; use Data::Dumper; my $VERSION = "1.0"; # External Version Number my $Status_file='./data/status.$lang'; my $DEFAULT_MSGID; sub process($$$$$) { my $mboxfolder = shift; my $lang = shift; my $check_bts = shift; my $init_msgId = shift; $Status_file = shift || $Status_file; print STDERR "mboxfolder: $mboxfolder\n"; my $db = Debian::L10n::Db->new(); my $dbName = $Status_file; $dbName =~ s/\$lang/$lang/g; my $msgId; if (-e $dbName) { $db->read($dbName, 0); $msgId = defined($init_msgId) ? $init_msgId : ($db->get_header('Message-ID') || $DEFAULT_MSGID ); print "Spider.pm Continue $lang from message $msgId\n"; } else { print "Spider.pm Creating a new DB for $lang\n"; # $year = $init_year; # $month = $init_month; # $message = $init_message; # $page = 1; # die "Cannot guess the begin year. Please use the --year options\n" unless defined($year); # die "Cannot guess the begin month. Please use the --month options\n" unless defined($month); # die "Cannot guess the begin message. Please use the --message options\n" unless defined($message); } if (not defined $mboxfolder) { # TODO: use tmpfile open TMP, ">", "/tmp/tata" or die "Cannot open ...: $!"; while () { print TMP $_; } close TMP; $mboxfolder = "/tmp/tata"; } my $f = Mail::Box::Mbox->new(folder => $mboxfolder, lock_type => undef) or die "Cannot open mailbox $mboxfolder.\n"; my $url = ""; # not used. # Try to see if this Message-ID is in the mailbox my $found = 0; if (defined $msgId) { foreach my $m ($f->messages) { if ($m->messageId eq $msgId) { $found = 1; last; } } } my ($status, $type, $bug_nb, @names); foreach my $m ($f->messages) { if ($found) { if ($m->messageId eq $msgId) { $found = 0; } last; } ($status, $type, $bug_nb, @names) = Debian::L10n::Utils::parse_subject($m->subject); print "Mail.pm: ".$m->subject."\n"; next unless $status; # unparsable mail my $translator; my $sender = $m->sender; if (defined $sender) { # May need to take care of the following that has been ejected from Debian/L10n/Utils.pm # unless ($_ =~ m/=?unknown-8bit?b?/) { # Encode::from_to($_, 'MIME-Header', 'utf8'); # } $translator = Debian::L10n::Utils::parse_from($sender->format()); } else { $translator = "UNDEF"; } my $date = Debian::L10n::Utils::parse_date("Date: ".$m->head->get('Date')); # We keep this Message-ID to reference this message my $list = $m->messageId; $msgId = $m->messageId; foreach my $pkg (@names) { my $file = $pkg; if (($type eq 'webwml') or ($type eq 'wml')) { $type = "wml"; $pkg =~ s|/.*||; if (($pkg=~/\./) && not($pkg =~ /\.wml$/)) { $file =~ s|.*?/||; } else { # www.debian.org $pkg = 'www.debian.org'; } } else { $pkg =~ s|/.*||; $file =~ s|.*?/||; } if ($db->has_package($pkg)) { # If a cycle was already finished. # Clear the status of this file # before we add status for the # new cycle. foreach my $statusline (@{$db->status($pkg)}) { my ($type_from_db, $file_from_db, $date_from_db, $status_from_db, $translator_from_db, $list_from_db, $url_from_db, $bug_nb_from_db) = @{$statusline}; if ( $type eq $type_from_db and $file eq $file_from_db and $status_from_db eq 'done' and $status ne 'done') { $db->del_status($pkg, $type, $file, $statusline); } } } unless ($db->has_package($pkg)) { $db->package($pkg); $db->add_package($pkg,$pkg); } $db->add_status($pkg, $type, $file, $date, $status, $translator, $list, $url, ($bug_nb || "")); } } continue { $db->set_header('Message-ID', $msgId ); $db->write($dbName); } Debian::L10n::BTS::check_bts($db, $dbName) if $check_bts; $db->write($dbName); Debian::L10n::Db::clean_db($db); $db->write($dbName); } 1; dl10n-3.00/lib/Debian/L10n/Html.pm0000644000000000000000000004552211704570256013163 0ustar package Html; use strict; use utf8; =head1 NAME dl10n-spider -- crawl translator mailing lists (and BTS) for status updates =head1 SYNOPSIS dl10n-spider [options] lang+ =head1 DESCRIPTION This script parses the debian-l10n-ElanguageE mailing list archives. It looks for emails which title follow a specific format indicating what the author intend to translate, or the current status of his work on this translation. Those informations are saved to a dl10n database which can then be used to build a l10n coordination page or any other useless statistics. =cut use LWP::UserAgent; use Digest::MD5 qw(md5_base64); use Debian::L10n::Db; use Time::Local 'timelocal'; use File::Path; use Data::Dumper; my $VERSION = "1.0"; # External Version Number my $Status_file='./data/status.$lang'; my $DEFAULT_YEAR = 2002; # Message on french ML introducing the syntax for the first time my $DEFAULT_MONTH = 3; my $DEFAULT_MESSAGE = 112; my $Web_agent = LWP::UserAgent -> new; my %Status = ( taf => 0, maj => 1, itt => 2, itr => 20, rfr => 3, lcfc => 4, bts => 5, fix => 6, wontfix => 7, done => 8, hold => 9, ); my %Status_syn = ( ddr => 'rfr', relu => 'lcfc', ); my %Type_syn = ( 'debian-installer' => 'podebconf', # debian-installer is a sub-category 'debconf-po' => 'podebconf', # typo 'po-debconf' => 'podebconf', # That's the way it should be witten in DB 'po-man' => 'man', # nobody uses po4a so far, but it may come ); my %LanguageList = ( ar => 'arabic', ca => 'catalan', cs => 'czech', de => 'german', en => 'english', es => 'spanish', fr => 'french', gl => 'galician', nl => 'dutch', # pt => 'portuguese', pt_BR => 'portuguese', ro => 'romanian', ru => 'russian', sk => 'slovak', sv => 'swedish', tr => 'turkish', all => 'all', ); my %Language = ( ar => 'arabic', ca => 'catalan', cs => 'czech', de => 'german', en => 'english', es => 'spanish', fr => 'french', gl => 'galician', nl => 'dutch', # pt => 'portuguese', pt_BR => 'brazilian', ro => 'romanian', ru => 'russian', sk => 'slovak', sv => 'swedish', tr => 'turkish', all => 'all', ); =head2 check_bts check_bts searches in the BTS for open bugs, it fixes the bug submission date if necessary, checks whether the bug is fixed or closed or not and updates the database accordingly. =cut sub by_date($$$) { my $db = shift; my $lang = shift; my $fh = shift; print $fh < EOF ; my %t; foreach my $pkg (sort (grep { $db->has_status($_) } $db->list_packages())) { my %list = (); # Only keep the last status per pkg#$type#$file (no history) foreach my $statusline (@{$db->status($pkg)}) { my ($type, $file, $date, $status, $translator, $list, $url, $bug_nb) = @{$statusline}; $list{"$type#$file"} = $statusline; } foreach my $k (keys %list) { my ($type, $file, $date, $status, $translator, $list, $url, $bug_nb) = @{$list{$k}}; $date =~ s/^(\d\d\d\d)-(\d\d)-(\d\d).*$/$1$2$3/; push @{$t{$date}{$pkg}{$type}{$file}}, $list{$k}; } } foreach my $date (sort keys %t) { my $curdate = $date; $curdate =~ s/^(\d\d\d\d)(\d\d)(\d\d)$/$1-$2-$3/; print $fh < EOF ; foreach my $pkg (sort keys %{$t{$date}}) { foreach my $type (sort keys %{$t{$date}{$pkg}}) { foreach my $file (sort keys %{$t{$date}{$pkg}{$type}}) { foreach my $statusline (@{$t{$date}{$pkg}{$type}{$file}}) { my ($stype, $sfile, $sdate, $status, $translator, $list, $url, $bug_nb) = @{$statusline}; $sdate =~ s/\ \+0000//; $translator = "" if $status eq "taf"; $translator = "" if $status eq "todo"; $translator = "" if $status eq "maj"; $list =~ /^(\d\d\d\d)-(\d\d)-(\d\d\d\d\d)$/; $list = "[$1-$2-$3]"; $bug_nb = $bug_nb ? "#$bug_nb" : ""; print $fh < EOF ; } } } } print $fh < EOF ; } print $fh < EOF ; } sub by_bug($$$) { my $db = shift; my $lang = shift; my $fh = shift; print $fh < EOF ; my %t; foreach my $pkg (sort (grep { $db->has_status($_) } $db->list_packages())) { my %list = (); # Only keep the last status per pkg#$type#$file (no history) foreach my $statusline (@{$db->status($pkg)}) { my ($type, $file, $date, $status, $translator, $list, $url, $bug_nb) = @{$statusline}; $list{"$type#$file"} = $statusline; } foreach my $k (keys %list) { my ($type, $file, $date, $status, $translator, $list, $url, $bug_nb) = @{$list{$k}}; next unless $bug_nb; push @{$t{$bug_nb}{$pkg}{$type}{$file}}, $list{$k}; } } foreach my $bug_nb (sort keys %t) { print $fh < EOF ; foreach my $pkg (sort keys %{$t{$bug_nb}}) { foreach my $type (sort keys %{$t{$bug_nb}{$pkg}}) { foreach my $file (sort keys %{$t{$bug_nb}{$pkg}{$type}}) { foreach my $statusline (@{$t{$bug_nb}{$pkg}{$type}{$file}}) { my ($stype, $sfile, $date, $status, $translator, $list, $url, $sbug_nb) = @{$statusline}; $date =~ s/\ \+0000//; $list =~ /^(\d\d\d\d)-(\d\d)-(\d\d\d\d\d)$/; $list = "[$1-$2-$3]"; $sbug_nb = $sbug_nb ? "#$sbug_nb" : ""; print $fh < EOF ; } } } } print $fh < EOF ; } print $fh < EOF ; } sub by_translator($$$) { my $db = shift; my $lang = shift; my $fh = shift; print $fh < EOF ; my %t; foreach my $pkg (sort (grep { $db->has_status($_) } $db->list_packages())) { my %list = (); # Only keep the last status per pkg#$type#$file (no history) foreach my $statusline (@{$db->status($pkg)}) { my ($type, $file, $date, $status, $translator, $list, $url, $bug_nb) = @{$statusline}; $list{"$type#$file"} = $statusline; } foreach my $k (keys %list) { my ($type, $file, $date, $status, $translator, $list, $url, $bug_nb) = @{$list{$k}}; $translator = "" if $status eq "taf"; $translator = "" if $status eq "todo"; $translator = "" if $status eq "maj"; push @{$t{$translator}{$pkg}{$type}{$file}}, $list{$k}; } } foreach my $translator (sort keys %t) { my $anchor = $translator; $anchor =~ s/\s//g; print $fh < EOF ; foreach my $pkg (sort keys %{$t{$translator}}) { foreach my $type (sort keys %{$t{$translator}{$pkg}}) { foreach my $file (sort keys %{$t{$translator}{$pkg}{$type}}) { my $lastline = ""; foreach my $statusline (@{$t{$translator}{$pkg}{$type}{$file}}) { my ($stype, $sfile, $date, $status, $stranslator, $list, $url, $bug_nb) = @{$statusline}; $date =~ s/\ \+0000//; $list =~ /^(\d\d\d\d)-(\d\d)-(\d\d\d\d\d)$/; $list = "[$1-$2-$3]"; $bug_nb = $bug_nb ? "#$bug_nb" : ""; if ("#$pkg#$type#$file" ne $lastline) { $lastline = "#$pkg#$type#$file"; print $fh < EOF ; } else { print $fh < EOF ; } print $fh <$translator EOF ; } } } } print $fh < EOF ; } print $fh < EOF ; } sub by_type($$$) { my $db = shift; my $lang = shift; my $fh = shift; print $fh < EOF ; my %t; foreach my $pkg (sort (grep { $db->has_status($_) } $db->list_packages())) { my %list = (); foreach my $statusline (@{$db->status($pkg)}) { my ($type, $file, $date, $status, $translator, $list, $url, $bug_nb) = @{$statusline}; push @{$t{$type}{$pkg}{$file}}, $statusline; } } foreach my $type (sort keys %t) { my $anchor = $type; print $fh < EOF ; foreach my $pkg (sort keys %{$t{$type}}) { foreach my $file (sort keys %{$t{$type}{$pkg}}) { my $lastline = ""; foreach my $statusline (@{$t{$type}{$pkg}{$file}}) { my ($stype, $sfile, $date, $status, $translator, $list, $url, $bug_nb) = @{$statusline}; $date =~ s/\ \+0000//; $list =~ /^(\d\d\d\d)-(\d\d)-(\d\d\d\d\d)$/; $list = "[$1-$2-$3]"; $bug_nb = $bug_nb ? "#$bug_nb" : ""; if ("#$pkg#$type#$file" ne $lastline) { $lastline = "#$pkg#$type#$file"; print $fh < EOF ; } else { print $fh < EOF ; } print $fh <$translator EOF ; } } } print $fh < EOF ; } print $fh < EOF ; } sub by_status($$$) { my $db = shift; my $lang = shift; my $fh = shift; print $fh < EOF ; my %t; foreach my $pkg (sort (grep { $db->has_status($_) } $db->list_packages())) { my %list = (); # Only keep the last status per pkg#$type#$file (no history) foreach my $statusline (@{$db->status($pkg)}) { my ($type, $file, $date, $status, $translator, $list, $url, $bug_nb) = @{$statusline}; $list{"$type#$file"} = $statusline; } foreach my $k (keys %list) { my ($type, $file, $date, $status, $translator, $list, $url, $bug_nb) = @{$list{$k}}; push @{$t{$status}{$pkg}{$type}{$file}}, $list{$k}; } } my %s = reverse %Status; foreach my $score (sort keys %s) { my $status = $s{$score}; my $anchor = $status; print $fh < EOF ; foreach my $pkg (sort keys %{$t{$status}}) { foreach my $type (sort keys %{$t{$status}{$pkg}}) { foreach my $file (sort keys %{$t{$status}{$pkg}{$type}}) { foreach my $statusline (@{$t{$status}{$pkg}{$type}{$file}}) { my ($stype, $sfile, $date, $sstatus, $translator, $list, $url, $bug_nb) = @{$statusline}; $date =~ s/\ \+0000//; $list =~ /^(\d\d\d\d)-(\d\d)-(\d\d\d\d\d)$/; $list = "[$1-$2-$3]"; $bug_nb = $bug_nb ? "#$bug_nb" : ""; print $fh < EOF ; } } } } print $fh < EOF ; } print $fh < EOF ; } sub by_package($$$) { my $db = shift; my $lang = shift; my $fh = shift; print $fh < EOF ; my %t; foreach my $pkg (sort (grep { $db->has_status($_) } $db->list_packages())) { my %list = (); foreach my $statusline (@{$db->status($pkg)}) { my ($type, $file, $date, $status, $translator, $list, $url, $bug_nb) = @{$statusline}; push @{$t{$pkg}{$type}{$file}}, $statusline; } } foreach my $pkg (sort keys %t) { my $anchor = $pkg; print $fh < EOF ; foreach my $type (sort keys %{$t{$pkg}}) { foreach my $file (sort keys %{$t{$pkg}{$type}}) { my $lastline = ""; foreach my $statusline (@{$t{$pkg}{$type}{$file}}) { my ($stype, $sfile, $date, $status, $translator, $list, $url, $bug_nb) = @{$statusline}; $date =~ s/\ \+0000//; $list =~ /^(\d\d\d\d)-(\d\d)-(\d\d\d\d\d)$/; $list = "[$1-$2-$3]"; $bug_nb = $bug_nb ? "#$bug_nb" : ""; if ("#$pkg#$type#$file" ne $lastline) { $lastline = "#$pkg#$type#$file"; print $fh < EOF ; } else { print $fh < EOF ; } print $fh <$translator EOF ; } } } print $fh < EOF ; } print $fh < EOF ; } sub html($@) { $Status_file = shift || $Status_file; $_ = shift || 'all'; my @langs; if (m/^all$/i) { @langs = keys %Language; } else { @langs = ($_, @_); } while (my $lang = shift @langs) { die "Html.pm: Lang '$lang' unknown. Please update \%Language.\n" unless $Language{$lang}; my $db = Debian::L10n::Db->new(); my $dbName = "$Status_file"; # FIXME add $lang if not provided in command line FIXME $dbName =~ s/\$lang/$lang/g; if (-e $dbName) { $db->read($dbName, 0); } else { warn "Cannot find $dbName"; next; } mkpath ("include", 02775) or die "Cannot create include directory\n" unless (-d "include"); open FH, ">include/$lang.by_package.inc" or die "Cannot open by_package.inc: $!"; by_package ($db, $lang, *FH); close FH; open FH, ">include/$lang.by_type.inc" or die "Cannot open by_type.inc: $!"; by_type ($db, $lang, *FH); close FH; open FH, ">include/$lang.by_translator.inc" or die "Cannot open by_translator.inc: $!"; by_translator ($db, $lang, *FH); close FH; open FH, ">include/$lang.by_status.inc" or die "Cannot open by_status.inc: $!"; by_status ($db, $lang, *FH); close FH; open FH, ">include/$lang.by_bug.inc" or die "Cannot open by_bug.inc: $!"; by_bug ($db, $lang, *FH); close FH; open FH, ">include/$lang.by_date.inc" or die "Cannot open by_date.inc: $!"; by_date ($db, $lang, *FH); close FH; } } =head1 LICENSE 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. =head1 COPYRIGHT (C) 2003,2004 Tim Dijkstra 2004 Nicolas Bertolissio 2004 Martin Quinson 2008 Nicolas Franois =cut 1; dl10n-3.00/lib/Debian/L10n/Debconf.pm0000644000000000000000000004054711544665464013631 0ustar #!/usr/bin/perl -w ## Copyright (C) 2001 Denis Barbier ## Copyright (C) 2004 Martin Quinson ## ## 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 2 of the License, or ## (at your option) any later version. =head1 NAME Debian::L10n::Debconf - translation status of Debconf templates =head1 SYNOPSIS use Debian::L10n::Debconf; my $tmpl = Debian::L10n::Debconf->new(); $tmpl->read_compact($file); my @languages = $tmpl->langs(); foreach (sort @languages) { my ($t,$f,$u) = $tmpl->stats($_); print "$_:${t}t${f}f${u}u\n"; } =head1 DESCRIPTION This module extracts informations about translation status of Debconf templates files. =head1 METHODS =over 4 =cut package Debian::L10n::Debconf; use strict; =item new This is the constructor. my $tmpl = Debian::L10n::Debconf->new(); =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = {}; bless ($self, $class); $self->_init(); return $self; } sub _init { my $self = shift; $self->{orig} = {}; $self->{count} = 0; $self->{trans} = {}; $self->{langs} = {}; $self->{files} = {}; } =item read_compact Read a templates file containing all translations. An optional second argument may be used, any non-zero value tells that this file comes with translations in other files. In such a case no warning is raised if this file contains translated fields, because maintainer is assumed to be responsible for such translations. $tmpl->read_compact($file); =cut sub read_compact { my $self = shift; my $file = shift; my $safe = shift || 0; my ($lang, $msg); $self->_init(); open (TMPL, "< $file") || die "Unable to read file $file\n"; my $tmpl = ''; my $line = 0; while () { chomp; $line ++; if (m/^[A-Z][a-z]*-[A-Za-z_]+-fuzzy:/) { warn "$file:$line: fuzzy-fields-in-templates\n"; goto SKIP; } if ((!$safe) && m/^[A-Z][a-z]*-[A-Za-z_]+:/) { warn "$file:$line: translated-fields-in-master-templates\n"; # Display this message only once $safe = 1; } if (s/^Template:\s*//) { $tmpl = $_; $self->{orig}->{$tmpl} = {}; } elsif (s/^(Choices):\s*//) { if ($tmpl eq '') { warn "$file:$line: \`$1' field found before \`Template'\n"; goto SKIP; } $self->{orig}->{$tmpl}->{choices} = $_; $self->{count} ++; } elsif (s/^(Description):\s*//) { if ($tmpl eq '') { warn "$file:$line: \`$1' field found before \`Template'\n"; goto SKIP; } $msg = $_ . "\n"; while () { $line ++; last if (!defined($_) || m/^\S/ || m/^$/m); $msg .= $_; } $msg =~ s/^\s+//gm; $msg =~ s/\s+$//gm; $msg =~ tr/ \t\n/ /s; $self->{orig}->{$tmpl}->{description} = $msg; $self->{count} ++; last unless defined($_); $line --; redo; } elsif (s/^(Choices-(.*?)):\s*//) { if ($tmpl eq '') { warn "$file:$line: \`$1' field found before \`Template'\n"; goto SKIP; } $lang = $2; unless (defined($self->{langs}->{$lang})) { $self->{langs}->{$lang} = 1; $self->{trans}->{$lang}->{count} = 0; $self->{trans}->{$lang}->{fuzzy} = 0; } $self->{trans}->{$lang}->{count} ++; } elsif (s/^(Description-(.*?)):\s+//) { if ($tmpl eq '') { warn "$file:$line: \`$1' field found before \`Template'\n"; goto SKIP; } $lang = $2; unless (defined($self->{langs}->{$lang})) { $self->{langs}->{$lang} = 1; $self->{trans}->{$lang}->{count} = 0; $self->{trans}->{$lang}->{fuzzy} = 0; } do { $_ = ; $line ++; } until (!defined($_) || m/^\S/ || m/^$/m); $self->{trans}->{$lang}->{count} ++; last unless defined($_); $line --; redo; } elsif (m/^\s*$/) { $tmpl = ''; } elsif (m/^(Type|Default)/) { # Ignored fields } else { warn "$file:$line: Wrong input line:\n $_\n"; } next; SKIP: while () { $line ++; last if (!defined($_) || m/^\S/ || m/^$/m); } last unless defined($_); $line --; redo; } close(TMPL); } =item read_dispatched Read templates contained in several files. First argument is the English file, all other arguments are translated templates files. @trans = qw(templates.de templates.fr templates.ja templates.nl); $tmpl->read_dispatched('templates', @trans); =cut sub read_dispatched { my $self = shift; my $file = shift; $self->_init(); $self->read_compact($file, 1); $self->{trans} = {}; $self->{langs} = {}; foreach my $trans (@_) { $self->_read_dispatched($trans); } } sub _read_dispatched { my $self = shift; my $file = shift; my ($lang, $msg, $status_c, $status_d); open (TMPL, "< $file") || die "Unable to read file $file\n"; my $tmpl = ''; my $line = 0; my $ext = $file; $ext =~ s/.*\.//; while () { chomp; $line ++; if (m/^[A-Z][a-z]*-[A-Za-z_]+-fuzzy:/) { warn "$file:$line: fuzzy-fields-in-templates\n"; goto SKIP; } if (s/^Template:\s*//) { $tmpl = $_; $status_c = $status_d = ''; unless (defined $self->{orig}->{$tmpl}) { warn "$file:$line: translated-templates-not-in-original $_\n"; while () { $line ++; last if (!defined($_) || m/^$/); } last unless defined($_); $line --; redo; } } elsif (s/^(Choices):\s*//) { if ($tmpl eq '') { warn "$file:$line: \`$1' field found before \`Template'\n"; goto SKIP; } next unless defined $self->{orig}->{$tmpl}; if (defined($self->{orig}->{$tmpl}->{choices}) && $_ eq $self->{orig}->{$tmpl}->{choices}) { $status_c = 'count'; } else { $status_c = 'fuzzy'; } } elsif (s/^(Choices-(.*?)):\s*//) { if ($tmpl eq '') { warn "$file:$line: \`$1' field found before \`Template'\n"; goto SKIP; } $lang = $2; if ($lang ne $ext) { warn "$file:$line: lang-mismatch-in-translated-templates\n" } else { unless (defined($self->{langs}->{$lang})) { $self->{langs}->{$lang} = 1; $self->{trans}->{$lang}->{count} = 0; $self->{trans}->{$lang}->{fuzzy} = 0; } if ($status_c) { $self->{trans}->{$lang}->{$status_c} ++; } else { warn "$file:$line: original-fields-removed-in-translated-templates\n"; } $status_c = ''; } } elsif (s/^(Description):\s*//) { if ($tmpl eq '') { warn "$file:$line: \`$1' field found before \`Template'\n"; goto SKIP; } next unless defined $self->{orig}->{$tmpl}; $msg = $_ . "\n"; while () { $line ++; last if (!defined($_) || m/^\S/ || m/^$/m); $msg .= $_; } $msg =~ s/^\s+//gm; $msg =~ s/\s+$//gm; $msg =~ tr/ \t\n/ /s; if (defined($self->{orig}->{$tmpl}->{description}) && $msg eq $self->{orig}->{$tmpl}->{description}) { $status_d = 'count'; } else { $status_d = 'fuzzy'; } last unless defined($_); $line --; redo; } elsif (s/^(Description-(.*?)):\s+//) { if ($tmpl eq '') { warn "$file:$line: \`$1' field found before \`Template'\n"; goto SKIP; } $lang = $2; if ($lang ne $ext) { warn "$file:$line: lang-mismatch-in-translated-templates\n"; do { $_ = ; $line ++; } until (!defined($_) || m/^\S/ || m/^$/m); } else { if (defined($self->{files}->{$lang})) { die "Lang \`$lang' found in \`$file' and \`$self->{files}->{$lang}'\n" unless $self->{files}->{$lang} eq $file; } else { $self->{files}->{$lang} = $file; } unless (defined($self->{langs}->{$lang})) { $self->{langs}->{$lang} = 1; $self->{trans}->{$lang}->{count} = 0; $self->{trans}->{$lang}->{fuzzy} = 0; } do { $_ = ; $line ++; } until (!defined($_) || m/^\S/ || m/^$/m); if ($status_d) { $self->{trans}->{$lang}->{$status_d} ++; } else { warn "$file:$line: original-fields-removed-in-translated-templates\n"; } $status_d = ''; } last unless defined($_); $line --; redo; } elsif (m/^\s*$/) { $tmpl = ''; $status_c = $status_d = ''; } elsif (m/^(Type|Default)/) { # Ignored fields } else { warn "$file:$line: Wrong input line:\n $_\n"; } next; SKIP: while () { $line ++; last if (!defined($_) || m/^\S/ || m/^$/); } last unless defined($_); $line --; redo; } close(TMPL); } =item langs Return the languages in which this templates file is translated. my @list = $tmpl->langs(); =cut sub langs { my $self = shift; return keys %{$self->{langs}}; } =item filename When templates are dispatched into several files, return the filename in which the language passed as argument is found. my $filename = $tmpl->filename("de"); =cut sub filename { my $self = shift; my $lang = shift; return (defined($self->{files}->{$lang}) ? $self->{files}->{$lang} : ''); } =item count Return the number of translatable strings in this templates file. my $number = $tmpl->count(); =cut sub count { my $self = shift; return $self->{count}; } =item stats With an argument, return an array consisting of the number of translated, fuzzy and untranslated strings for the language given as argument. Without argument, return a hash array indexed by language and returning an array of the number of translated, fuzzy and untranslated strings. my ($t, $f, $u) = $tmpl->stats("de"); my %stats = $tmpl->stats(); foreach (keys %stats) { print $_.':'. $stats{$_}->[0].'t'.$stats{$_}->[1].'f'. $stats{$_}->[2]."u\n"; } =cut sub stats { my $self = shift; my $lang; if (@_) { $lang = shift; if (defined($self->{langs}->{$lang})) { return ($self->{trans}->{$lang}->{count}, $self->{trans}->{$lang}->{fuzzy}, $self->{count} - $self->{trans}->{$lang}->{fuzzy} - $self->{trans}->{$lang}->{count}); } else { return (0,0,0); } } else { my %stats = (); foreach $lang (keys %{$self->{langs}}) { $stats{$lang} = [ $self->{trans}->{$lang}->{count}, $self->{trans}->{$lang}->{fuzzy}, $self->{count} - $self->{trans}->{$lang}->{fuzzy} - $self->{trans}->{$lang}->{count} ]; } return %stats; } } =item entries Return an array containing all Debconf ids found in this templates file. my @ids = $tmpl->entries(); =cut sub entries { my $self = shift; return keys %{$self->{orig}}; } =back =head1 AUTHOR Copyright (C) 2001 Denis Barbier 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 2 of the License, or (at your option) any later version. =cut 1; dl10n-3.00/lib/Debian/L10n/Spider.pm0000644000000000000000000002422011544665464013505 0ustar package Spider; use strict; use utf8; =head1 NAME dl10n-spider -- crawl translator mailing lists (and BTS) for status updates =head1 SYNOPSIS dl10n-spider [options] lang+ =head1 DESCRIPTION This script parses the debian-l10n-ElanguageE mailing list archives. It looks for emails which title follow a specific format indicating what the author intend to translate, or the current status of his work on this translation. Those informations are saved to a dl10n database which can then be used to build a l10n coordination page or any other useless statistics. =cut use LWP::UserAgent; use Debian::L10n::Db; use Debian::L10n::BTS; use Debian::L10n::Utils; use MIME::Base64; use List::Util qw(max); use Data::Dumper; my $VERSION = "1.0"; # External Version Number my $Status_file='./data/status.$lang'; my $DEFAULT_YEAR = 2002; # Message on french ML introducing the syntax for the first time my $DEFAULT_MONTH = 3; my $DEFAULT_MESSAGE = 0; my $Web_agent = LWP::UserAgent -> new; $Web_agent->env_proxy; =head2 get_header(HTML) get_header extract the email header from the html page. This header starts at E!--X-Head-of-Message--E and stops at E!--X-Head-of-Message-End--E. As it contains html tags, they are also removed. It gets a reference to an array of line (HTML) containing the html code of the page. It returns a reference to an array containing the email header lines. =cut sub get_header($) { my $html = shift; my @header; foreach $_ (@{$html}) { next unless @header or //; # begin boundary last if //; # end boundary s/<[^>]*>//g; s/>/>/g; s/</; close FH; chomp @html; } else { my $answer = $Web_agent -> request(HTTP::Request -> new (GET => "http://lists.debian.org/$file")); # The download of the web page may fail. # Retry three times. unless ($answer -> is_success) { $answer = $Web_agent -> request(HTTP::Request -> new (GET => "http://lists.debian.org/$file")); } unless ($answer -> is_success) { $answer = $Web_agent -> request(HTTP::Request -> new (GET => "http://lists.debian.org/$file")); } unless ($answer -> is_success) { warn "Failed to retrieve 'http://lists.debian.org/$file'\n"; return undef; } my $html = $answer -> content; @html = split(/\n/, $html); } return \@html; } =head2 get_indexpage retrieves all messages numbers and subjects from a page of messages sorted by date. It return a hash table with message number as keys and subject as values (this is really quicker than retrieving each message). =cut sub get_indexpage($$$$) { my $language = shift; my $year = shift; my $month = shift; my $page = shift; my %messages; my @html; my $file = sprintf "debian-l10n-%s/%d/debian-l10n-%s-%d%02d/mail%s.html", $language, $year, $language, $year, $month, ($page == 1 ? "list" : $page); if (-e '/org/lists.debian.org/www') { return undef unless -e "/org/lists.debian.org/www/$file"; open FH, "; close FH; chomp @html; } else { my $answer = $Web_agent -> request(HTTP::Request -> new (GET => "http://lists.debian.org/$file")); return undef unless $answer -> is_success; my $html = $answer -> content; @html = split /\n/, $html; } @html = grep /name="\d{5}" href="msg\d{5}\.html"/, @html; %messages = (%messages, map { m/name="(\d{5})"/; my $n = $1; s/<.*?>//g; ($n, $_) } @html); return \%messages; } sub spider($$$$$@) { my $init_year = shift; my $init_month = shift; my $init_message = shift; my $check_bts = shift; $Status_file = shift || $Status_file; $_ = shift || 'all'; my @langs; if (m/^all$/i) { @langs = keys %Debian::L10n::Utils::Language; } else { @langs = ($_, @_); } while (my $lang = shift @langs) { die "Spider.pm: Lang '$lang' unknown. Please update \%Language.\n" unless $Debian::L10n::Utils::Language{$lang}; print "Spider.pm $Debian::L10n::Utils::Language{$lang}\n"; my $year; my $month; my $message; my $page; my $db = Debian::L10n::Db->new(); my $dbName = "$Status_file"; # FIXME add $lang if not provided in command line FIXME $dbName =~ s/\$lang/$lang/g; if (-e $dbName) { $db->read($dbName, 0); $year = (defined($init_year) ? $init_year : ($db->get_header('Year') || $DEFAULT_YEAR )); $month = (defined($init_month) ? $init_month : ($db->get_header('Month') || $DEFAULT_MONTH )); $message = (defined($init_message) ? $init_message : ($db->get_header('Message') || $DEFAULT_MESSAGE)); $page = (defined($init_message) ? 1 : ($db->get_header('Page') || 1 )); print "Spider.pm Continue $Debian::L10n::Utils::Language{$lang} from message $year/$month/$message\n"; } else { print "Spider.pm Creating a new DB for $Debian::L10n::Utils::Language{$lang}\n"; $year = $init_year; $month = $init_month; $message = $init_message; $page = 1; die "Cannot guess the begin year. Please use the --year options\n" unless defined($year); die "Cannot guess the begin month. Please use the --month options\n" unless defined($month); die "Cannot guess the begin message. Please use the --message options\n" unless defined($message); $message--; } my $last_ok = 1; $message++; while (1) { my $messages = get_indexpage($Debian::L10n::Utils::LanguageList{$lang}, $year, $month, $page); # if no more page, check if we need to look at next month unless ($messages) { last unless $last_ok; $message = 0; $page = 1; $month++; if ($month == 13) { $month = 1; $year++; } $last_ok = 0; redo; } $last_ok = 1; while ($message <= max(keys %$messages)) { my $key = sprintf("%05d", $message); my ($status, $type, $bug_nb, @names); if (defined ${$messages}{$key}) { ($status, $type, $bug_nb, @names) = Debian::L10n::Utils::parse_subject(${$messages}{$key}); print "Spider.pm: [$lang:$year/$month/$message] ${$messages}{$key}\n"; next unless $status; # unparsable mail } my $html = get_message($Debian::L10n::Utils::LanguageList{$lang}, $year, $month, $message); next unless defined $html; my $header = get_header($html); if (not defined ${$messages}{$key}) { my ($s) = grep(/Subject: / , @$header); ($status, $type, $bug_nb, @names) = Debian::L10n::Utils::parse_subject($s); print "Spider.pm: [$lang:$year/$month/$message] $s\n"; next unless $status; # unparsable mail } my ($t) = grep(/From: / , @$header); # In case there's no From header: $t = "UNKNOWN" unless defined $t; my $translator = Debian::L10n::Utils::parse_from($t); my ($d) = grep(/Date: / , @$header); my $date = Debian::L10n::Utils::parse_date($d); my $list = sprintf("%04d-%02d-%05d", $year, $month, $message); my $url = ""; foreach my $pkg (@names) { my $file = $pkg; if (($type eq 'webwml') or ($type eq 'wml')) { $type = "wml"; $pkg =~ s|/.*||; if (($pkg=~/\./) && not($pkg =~ /\.wml$/)) { $file =~ s|.*?/||; } else { # www.debian.org $pkg = 'www.debian.org'; } } else { $pkg =~ s|/.*||; $file =~ s|.*?/||; } if ($db->has_package($pkg)) { # If a cycle was already finished. # Clear the status of this file # before we add status for the # new cycle. foreach my $statusline (@{$db->status($pkg)}) { my ($type_from_db, $file_from_db, $date_from_db, $status_from_db, $translator_from_db, $list_from_db, $url_from_db, $bug_nb_from_db) = @{$statusline}; if ( $type eq $type_from_db and $file eq $file_from_db and $status_from_db eq 'done' and $status ne 'done') { $db->del_status($pkg, $type, $file, $statusline); } } } unless ($db->has_package($pkg)) { $db->package($pkg); $db->add_package($pkg,$pkg); } $db->add_status($pkg, $type, $file, $date, $status, $translator, $list, $url, ($bug_nb || "")); print "Insert $pkg: $type#$file#$date#$status#$translator#$list#$url#".($bug_nb ? "$bug_nb" : "")."\n"; } } continue { $db->set_header('Year', $year ); $db->set_header('Month', $month ); $db->set_header('Message', $message); $db->set_header('Page', $page ); $message++; $db->write($dbName); } } continue { $page++; } Debian::L10n::BTS::check_bts($db) if $check_bts; $db->write($dbName); Debian::L10n::Db::clean_db($db); $db->write($dbName); } } =head1 LICENSE 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. =head1 COPYRIGHT (C) 2003,2004 Tim Dijkstra 2004 Nicolas Bertolissio 2004 Martin Quinson =cut 1; dl10n-3.00/lib/Debian/L10n/BTS.pm0000644000000000000000000001555111704570256012706 0ustar =head1 NAME Debian::L10n::BTS - dl10n BTS access helper =cut package Debian::L10n::BTS; use strict; use utf8; use LWP::UserAgent; use Date::Parse; use Date::Format; use Encode qw(decode_utf8); use HTML::Entities qw(encode_entities_numeric); use Data::Dumper; my $VERSION = "1.0"; # External Version Number my $Web_agent = LWP::UserAgent -> new; $Web_agent->env_proxy; =head2 check_bts check_bts searches in the BTS for open bugs, it fixes the bug submission date if necessary, checks whether the bug is fixed or closed or not and updates the database accordingly. =cut sub check_bts($@) { my $db = shift; my $dbName = shift; check_bts_soap($db, $dbName); } my $BTS = "http://bugs.debian.org"; #my $BTS = "http://bugs.donarmstrong.com"; use Data::Dumper; use SOAP::Lite; my $soap = SOAP::Lite->uri('Debbugs/SOAP')->proxy("$BTS/cgi-bin/soap.cgi"); sub parse_submitter($) { my $submitter = shift; $submitter = Debian::L10n::Utils::parse_from($submitter); $submitter = decode_base64($submitter) if $submitter =~ /^: /; $submitter = encode_entities_numeric(decode_utf8($submitter)); $submitter =~ s/<//; return $submitter; } my %seen; my %opendate; my %closedate; my %bugsubmitter; sub check_bts_soap($$) { my $db = shift; my $dbName = shift; my @bugs_to_check; foreach my $pkg (sort (grep { $db->has_status($_) } $db->list_packages())) { # Only check a bug if the last status for a file/type is BTS my %last_status = (); foreach my $statusline (@{$db->status($pkg)}) { my ($type, $file, $date, $status_from_db, $translator, $list, $url, $bug_nb) = @{$statusline}; warn "$pkg\:$type\:$file does not specify the status\n" unless defined $status_from_db; $last_status{$type}{$file} = $statusline; } foreach my $t (keys %last_status) { foreach my $f (keys %{$last_status{$t}}) { my $statusline = $last_status{$t}{$f}; my ($type, $file, $date, $status_from_db, $translator, $list, $url, $bug_nb) = @{$statusline}; next unless defined $status_from_db; next unless $bug_nb; next unless ($status_from_db eq 'bts') || ($status_from_db eq 'wontfix') || ($status_from_db eq 'fix'); push @bugs_to_check, ($pkg, $statusline); } } } check_bts_bugs_soap ($db, $dbName, @bugs_to_check) if (@bugs_to_check); } sub check_bts_bugs_soap ($$@) { my ($db, $dbName, @bugs_to_check) = @_; # Get the list of bugs my $i = 0; my %bugs; while ( $i < $#bugs_to_check ) { my ($type, $file, $date, $status_from_db, $translator, $list, $url, $bug_nb) = @{$bugs_to_check[$i+1]}; $bugs{$bug_nb} = 1; $i+=2; } # Query the BTS my $soap_bugs = $soap->get_status([keys %bugs])->result(); if (not defined $soap_bugs or not length $soap_bugs) { warn "Failed to query the BTS\n"; return 0; } # Now we can Update the database my $count = 0; while (@bugs_to_check) { my $pkg = shift @bugs_to_check; my $statusline = shift @bugs_to_check; my $changed = 0; # 0: No changes # 1: Updated # 2: New status added my ($type, $file, $date, $status_from_db, $translator, $list, $url, $bug_nb) = @{$statusline}; my $bugwontfix = 0; # Make sure the database is written from time to time if ($count > 10) { $count = 0; $db->write($dbName) if defined $dbName; } unless ($seen{$bug_nb}) { my $bugdone = 0; my $content; my $pkg_bug = $soap_bugs->{$bug_nb}->{package}; my $src_bug = $soap_bugs->{$bug_nb}->{source}; if ( ($pkg_bug ne $pkg) and ($src_bug ne $pkg) and ($pkg_bug ne "wnpp")) { warn "Warning: #$bug_nb filled against $pkg_bug (source: $src_bug) but $pkg is in the database\n"; } $opendate{$bug_nb} = Date::Format::time2str("%Y-%m-%d %T %z", $soap_bugs->{$bug_nb}->{date}, "GMT"); $bugsubmitter{$bug_nb} = parse_submitter($soap_bugs->{$bug_nb}->{originator}); if ( defined $soap_bugs->{$bug_nb}->{done} and length $soap_bugs->{$bug_nb}->{done}) { $bugdone = 1; # TODO: differentiate fixed and done ? } else { $bugwontfix = 1 if ($soap_bugs->{$bug_nb}->{tags} =~ m/\bwontfix\b/); } if ($bugdone) { my $bts_url = "$BTS/cgi-bin/bugreport.cgi?bug=$bug_nb'}"; my $answer = $Web_agent -> request(HTTP::Request -> new (GET => $bts_url)); return 0 unless $answer -> is_success; $content = $answer -> content_ref; return 0 unless $$content; $seen{$bug_nb} = 1; $$content =~ /(.*?)Message #[0-9]+<\/a> received at (?:submit|maintonly)\@bugs\.debian\.org(.*)/ms; my $v = $$content; $v = $1 while ($v =~ /Message #[0-9]+<\/a> received at $bug_nb-(?:close|done)\@bugs\.debian\.org(.*)/ms); $v =~ /^Date:<\/b> (.*)/m; $closedate{$bug_nb} = $1; $closedate{$bug_nb} = Debian::L10n::Utils::parse_date("Date: ".$closedate{$bug_nb} || $date); } } if ($closedate{$bug_nb}) { if ($closedate{$bug_nb} ne $date) { $date = $closedate{$bug_nb}; $changed = 1 unless $changed == 2; } if ($status_from_db ne 'done') { print "close #$bug_nb of $pkg (at $closedate{$bug_nb})\n"; $status_from_db = 'done'; $changed = 2; } } else { if ($opendate{$bug_nb} ne $date) { print "fix date of #$bug_nb of $pkg from $date to $opendate{$bug_nb}.\n"; $date = $opendate{$bug_nb}; $changed = 1 unless $changed == 2; } if ($bugwontfix and $status_from_db ne 'wontfix') { print "wontfix #$bug_nb of $pkg\n"; $status_from_db = 'wontfix'; $changed = 2; } } if ($bugsubmitter{$bug_nb} ne $translator) { print "fix submitter of #$bug_nb of $pkg from $translator to $bugsubmitter{$bug_nb}.\n"; $translator = $bugsubmitter{$bug_nb}; $changed = 1 unless $changed == 2; } if ($status_from_db eq 'wontfix' and not $bugwontfix) { print "removing wontfix tag for #$bug_nb of $pkg\n"; $status_from_db = 'bts'; $changed = 2; } if ($changed == 2) { $db->add_status($pkg, $type, $file, $date, $status_from_db, $translator, $list, $url, $bug_nb); } elsif ($changed == 1) { $db->set_status($pkg, $type, $file, $date, $status_from_db, $translator, $list, $url, $bug_nb, $statusline); } } } =head1 LICENSE 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. =head1 COPYRIGHT (C) 2003,2004 Tim Dijkstra 2004 Nicolas Bertolissio 2004 Martin Quinson 2008 Nicolas François =cut 1; dl10n-3.00/lib/Debian/L10n/Utils.pm0000644000000000000000000001324011704570256013347 0ustar =head1 NAME Debian::L10n::Utils - Utilities for the dl10n tools =cut package Debian::L10n::Utils; use strict; use utf8; use Mail::Address; use Date::Parse; use Date::Format; use Encode; my $VERSION = "1.0"; # External Version Number our %Status = ( todo => 0, itt => 1, rfr => 2, itr => 3, lcfc => 4, bts => 5, fix => 6, done => 7, hold => 8, maj => 9, ); our %Status_syn = ( ddr => 'rfr', relu => 'lcfc', lfcf => 'lcfc', #this seems to be a current typo taf => 'todo', ); our %Type_syn = ( 'debian-installer' => 'podebconf', # debian-installer is a sub-category 'debconf-po' => 'podebconf', # typo 'po-debconf' => 'podebconf', # That's the way it should be witten in DB 'po-man' => 'man', # nobody uses po4a so far, but it may come ); our %LanguageList = ( ar => 'arabic', ca => 'catalan', cs => 'czech', de => 'german', en => 'english', es => 'spanish', fr => 'french', gl => 'galician', nl => 'dutch', # pt => 'portuguese', pt_BR => 'portuguese', ro => 'romanian', ru => 'russian', sk => 'slovak', sv => 'swedish', tr => 'turkish', ); our %Language = ( ar => 'arabic', ca => 'catalan', cs => 'czech', de => 'german', en => 'english', es => 'spanish', fr => 'french', gl => 'galician', nl => 'dutch', # pt => 'portuguese', pt_BR => 'brazilian', ro => 'romanian', ru => 'russian', sk => 'slovak', sv => 'swedish', tr => 'turkish', ); =head2 parse_subject(SUBJECT) parse_subject extract valuable informations from a subject line. It gets a string containing the subject line (SUBJECT). It returns an array containing the status, type, filename strings and bug number if provided or 'undef' if no status is found. =cut sub parse_subject($) { my $subject = shift; $subject =~ s/^Subject: //; $subject =~ s/ / /; $subject =~ m/^\p{IsSpace}*\[([^\]]*)\].*?([^:\p{IsSpace}]*):\/\/(\P{IsSpace}*)(.*)$/; return undef unless $1; my $status = lc $1; my $type = lc $2; my $names = $3; my $subject_end = $4; # Mutt split long subject and can introduce tabulations even if there were no spaces. # We remove the tabulations if inside {}, which deals with most of the long subjects. while ( defined $subject_end and $names =~ m/\{[^\}]*$/ and $subject_end =~ m/^\t+(\S*)(.*)\}(.*)$/) { $names .= $1; $subject_end = $2."\}".$3; } if (defined $subject_end) { if ($subject_end =~ m/^(\S+)/) { $names .= $1; } } $status =~ s/\p{IsSpace}//g; $status =~ s/#?\p{IsDigit}*$//; $status = $Status_syn{$status} if (defined $Status_syn{$status} && defined $Status{$Status_syn{$status}}); return undef unless defined $Status{$status}; $type = $Type_syn{$type} if defined $Type_syn{$type}; $subject =~ m/#\p{IsSpace}*(\p{IsDigit}+)/; my $bug_nb = $1 || undef; my @names; if ($names =~ m/{/) { $names =~ m/^([^{]*){([^}]*)}(.*)$/; my $begin = $1 || ""; my $end = $3 || ""; if (defined $2) { @names = map { "$begin$_$end" } split(/,/, $2); } else { warn "Could not parse Subject: '$subject'\n"; } } else { @names = ($names); } # print "Status='$status'; Type='$type'; ". (defined $bug_nb ? "bug_nb='$bug_nb'":"[no bug]")."\n"; return ($status, $type, $bug_nb, @names); } =head2 parse_from(FROM) parse_from extract the sender name from the 'From:' field. The name is build from the phrase part of the field, or if none is found, from the comment part where parentheses are removed, or if none is found, from the address where all non-alphanumeric characters are turned into spaces. It gets a string containing the 'From:' field (FROM). It returns a string containing the name. =cut sub parse_from($) { $_ = shift; return "UNDEF" if not defined $_; # No need to recode anything at this point, at least for the BTS # # http://lists.debian.org/debian-l10n-english/2009/07/msg00039.html # # Do not recode with a broken encoding # unless ($_ =~ m/=?unknown-8bit?b?/) { # Encode::from_to($_, 'MIME-Header', 'utf8'); # } s/^From: //; s/"//g; s/;/SEMICOLON/g; my @from = Mail::Address -> parse($_); $_ = $from[0]->phrase; s/SEMICOLON/;/g; s/ ; /;/g; unless ($_) { $_ = $from[0]->comment; s/^\p{IsSpace}*\(?//; s/\)?\p{IsSpace}*$//; s/SEMICOLON/;/g; s/ ; /;/g; } unless ($_) { $_ = $from[0]->address; s/\P{IsAlnum}/ /g; } $_ =~ s/^\s*"(.*)"\s*$/$1/g; return $_; } =head2 parse_date(DATE) parse_date extract the date from a 'Date:' field. It gets a string containing the 'Date:' field (DATE). It returns a string containing the date in ISO format yyyy-mm-dd hh:mm:ss ±hh:mm based on GMT =cut sub parse_date($) { my $d = shift; my $date; if ($d =~ m/^Date: (.*)$/) { $date = Date::Format::time2str("%Y-%m-%d %T %z", Date::Parse::str2time($1), "GMT"); } else { $date = Date::Format::time2str("%Y-%m-%d %T %z", $d, "GMT"); } return $date; } =head1 LICENSE 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. =head1 COPYRIGHT (C) 2003,2004 Tim Dijkstra 2004 Nicolas Bertolissio 2004 Martin Quinson 2008 Nicolas François =cut 1; dl10n-3.00/lib/Debian/L10n/Db.pm0000644000000000000000000004020611544665464012606 0ustar #!/usr/bin/perl -w ## Copyright (C) 2001-2004 Denis Barbier ## Copyright (C) 2004 Martin Quinson ## ## 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 2 of the License, or ## (at your option) any later version. =head1 NAME Debian::L10n::Db - handle database of debian l10n stuff =head1 SYNOPSIS use Debian::L10n::Db; my $l10n_db = Debian::L10n::Db->new(); $l10n_db->read("../data/unstable"); foreach ($l10n_db->list_packages()) { print "Package $_ ".$l10n_db->version($_)."\n"; } =head1 DESCRIPTION This module is an interface to the database files used in several places of the debian localisation infrastructure, such as the webpages under ClanguageE/internaltional/l10n/>. =head1 METHODS =over 4 =cut package Debian::L10n::Db; use strict; use Time::localtime; use Time::Local 'timelocal'; use File::Path; use Data::Dumper; # Do not use ``our'' to be compatible with Perl 5.005 use vars (qw($AUTOLOAD)); =item new This is the constructor, it only performs some initialization. my $l10n_db = Debian::L10n::Db->new(); =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = { data => {}, # Fields below constitute the header of the files. they are written # as fields of a package called '' (that's the same trick than in po files) # Language Year Month Message are for the spider headers => [qw{Date Language Year Month Message Page Message-ID}], # Fields below are written into file in the same order # Package must always be the first field # Switch is used temporarily to detect packages which # depend on debconf and did not switch to using po-debconf. scalar => [qw(Package Version Section Priority Maintainer PoolDir Type Upstream Switch )], array1 => [qw(Errors Catgets Gettext)], array2 => [qw(NLS PO TEMPLATES PODEBCONF PO4A MENU DESKTOP MAN STATUS)], }; $self->{methods} = {}; foreach (@{$self->{scalar}}) { $self->{fields}->{$_} = '$'; } foreach (@{$self->{array1}}) { $self->{fields}->{$_} = '@'; } foreach (@{$self->{array2}}) { $self->{fields}->{$_} = '@@'; } foreach (keys %{$self->{fields}}) { $self->{methods}->{lc $_} = $_; } bless ($self, $class); return $self; } sub AUTOLOAD { my $self = shift; my $type = ref($self) or die "$self is not an object"; my $pkg = shift; my $name = $AUTOLOAD; $name =~ s/.*://; # strip fully-qualified portion return defined($self->{data}->{$pkg}) if $name eq 'has_package'; # Add a new package into database $self->{data}->{$pkg} = {} if $name eq 'package'; if (! defined $self->{data}->{$pkg}) { warn __PACKAGE__.": Package $pkg does not exist, method \`$name' skipped\n"; return; } my $has = ""; my $add = ""; if ($name =~ s/^has_//) { $has = "has_"; } elsif ($name =~ s/^add_//) { $add = "add_"; } die "Can't access \`$has$name' method in class $type" unless defined($self->{methods}->{$name}); my $field = $self->{methods}->{$name}; if ($has) { return defined($self->{data}->{$pkg}->{$field}); } else { if ($#_ == -1) { if ($self->{fields}->{$field} =~ m/@/) { return $self->{data}->{$pkg}->{$field} || []; } return $self->{data}->{$pkg}->{$field}; } if ($self->{fields}->{$field} eq '$') { $self->{data}->{$pkg}->{$field} = $_[0]; } elsif ($self->{fields}->{$field} eq '@') { $self->{data}->{$pkg}->{$field} = [] unless defined($self->{data}->{$pkg}->{$field}) || !$add; push (@{$self->{data}->{$pkg}->{$field}}, @_); } elsif ($self->{fields}->{$field} eq '@@') { $self->{data}->{$pkg}->{$field} = [] unless defined($self->{data}->{$pkg}->{$field}) || !$add; my @list = @_; push (@{$self->{data}->{$pkg}->{$field}}, \@list); } else { die __PACKAGE__.":internal error: unknown data type:".$self->{fields}->{$field}."\n"; } } } # Perl 5.6.1 complains when it does not find this routine sub DESTROY { } =item read Read database from a given file. Returns 1 on success and otherwise 0. $l10n_db->read("foo"); =cut sub read { my $self = shift; my $file = shift; my $check = shift; $check = 1 unless defined $check; if ($file =~ m/\.gz$/) { open (DB,"gzip -dc $file |") || return 0; } else { open (DB,"< $file") || return 0; } MAIN: while (1) { my $entry = {}; my $desc = ''; my $last_item = 0; my $text; while () { last if m/^\s*$/; $desc .= $_; } if ($desc =~ m/^[0-9]{4}-[0-9]{2}-[0-9]{2}$/) { # Parse old format date $self->set_date($_); next MAIN; } if (!defined($_)) { last unless $desc =~ m/\S/; $last_item = 1; } # Leading tabs are illegal, but handle them anyway $desc =~ s/^\t/ \t/mg; foreach (@{$self->{scalar}}) { if ($desc =~ m/^$_: ?(.*)$/m) { if ($_ eq 'Package' && defined $self->{data}->{$1} && length($1)) { $entry = $self->{data}->{$1}; } elsif ($_ eq 'Package' && length($1) == 0) { foreach (@{$self->{headers}}) { if ($desc =~ m/^$_: (.*)$/m) { $self->set_header($_,$1); } } next MAIN; } else { $entry->{$_} = $1; } } elsif ($check && $_ ne 'Switch' && $_ ne 'STATUS') { $desc =~ s/^/ /mg; warn "Parse error when reading $file: Package ".(defined($entry->{Package}) ? $entry->{Package} : "").": missing \`$_' field\nDescription follows:\n$desc\n"; # next MAIN; } } foreach (@{$self->{array1}}) { if ($desc =~ m/(^|\n)$_:\n(.+?)(\n\S|$)/s) { $text = $2; $text =~ s/^ //mg; my @list = split(/\n\./, $text); $entry->{$_} = \@list; } } foreach (@{$self->{array2}}) { if ($desc =~ m/(^|\n)$_:\n(.+?)(\n\S|$)/s) { $text = $2; $text =~ s/^ //mg; my @list = (); foreach my $line (split(/\n/, $text)) { my @list2 = split('!', $line); push(@list, \@list2); } $entry->{$_} = \@list; } } $self->{data}->{$entry->{Package}} = $entry; last if $last_item; } close DB; return defined($self->{data}->{''}->{Date}); } =item write Write database into file. $l10n_db->write("foo"); =cut sub write { my $self = shift; my $file = shift; my ($text, $line); my $dir = $file; File::Path::mkpath($dir, 0, 0755) if ($dir =~ s#/+[^/]*$## && !-d $dir); if ($file =~ m/\.gz$/) { open (DB,"| gzip -c > $file") || die "Unable to write to $file: $!\n"; } else { open (DB,"> $file") || die "Unable to write to $file: $!\n"; } $self->set_date(sprintf "%d-%02d-%02d", Time::localtime::localtime->year() + 1900, Time::localtime::localtime->mon() + 1, Time::localtime::localtime->mday); print DB "Package:\n"; foreach (@{$self->{headers}}) { next unless defined($self->{data}->{''}->{$_}); print DB $_.": ".$self->{data}->{''}->{$_}."\n"; } print DB "\n"; foreach my $pkg (sort keys %{$self->{data}}) { next if $pkg eq ''; # skip headers foreach (@{$self->{scalar}}) { next unless defined($self->{data}->{$pkg}->{$_}); print DB $_.": ".$self->{data}->{$pkg}->{$_}."\n"; } foreach (@{$self->{array1}}) { next unless defined($self->{data}->{$pkg}->{$_}); $text = join("\n\.\n", @{$self->{data}->{$pkg}->{$_}})."\n"; $text =~ s/\n\n/\n/g; $text =~ s/\n+$//s; $text =~ s/^/ /mg; print DB $_.":\n".$text."\n"; } foreach (@{$self->{array2}}) { next unless defined($self->{data}->{$pkg}->{$_}); $text = ''; foreach $line (@{$self->{data}->{$pkg}->{$_}}) { $text .= ' '.join('!', @{$line})."\n"; } print DB $_.":\n".$text; } print DB "\n"; } close (DB) || die "Unable to close $file: $!\n"; } =item list_packages Returns an array with the list of package names =cut sub list_packages { my $self = shift; return keys %{$self->{data}}; } =item clear_pkg Reset info for a given package $l10n_db->clear_pkg("foo"); =cut sub clear_pkg { my $self = shift; my $pkg = shift; delete $self->{data}->{$pkg}; } =item set_status Change the status for the category specified as second argument. =cut sub set_status { my ($db,$pkg,$type,$file,$date,$status,$translator,$list,$url,$bug_nb,$statusline) = @_; foreach my $line (@{$db->{data}->{$pkg}->{STATUS}}) { if ( (defined($statusline) and ($statusline == $line)) or ( not defined($statusline) and ${$line}[0] eq $type and ${$line}[1] eq $file)) { ${$line}[2] = $date; ${$line}[3] = $status; ${$line}[4] = $translator; ${$line}[5] = $list; ${$line}[6] = $url; ${$line}[7] = $bug_nb; return } } $db->add_status($pkg,$type,$file,$date,$status,$translator,$list,$url,$bug_nb); } =item del_status If a reference to a statusline is provided, it removes the first found It should remove the right line (pkg, type, and file) from the DB, and empty the package if nothing else is left. =cut sub del_status { my ($db,$pkg,$type,$file,$statusline) = @_; if (not defined $file and not defined $type) { my $ok; for (my $i=0; $i < @{$db->{data}->{$pkg}->{STATUS}}; $i++) { my @a = @$statusline; my @b = @{$db->{data}->{$pkg}->{STATUS}->[$i]}; $ok = 1; while (scalar @a) { next if (shift(@a) eq shift(@b)); $ok = 0; last; } next unless $ok; splice @{$db->{data}->{$pkg}->{STATUS}}, $i, 1; last; } print "Cannot del_status, statusline not found in package $pkg\n" unless $ok; } else { my $found = 0; my $linefound = 0; $linefound = 1 if not defined $statusline; if (defined $db->{data}->{$pkg}->{STATUS}) { for (my $i=@{$db->{data}->{$pkg}->{STATUS}}; $i > 0; $i--) { # If a specific statusline was specified, do not remove lines more recent that this statusline. if ($linefound == 0) { my $ok = 1; my @a = @$statusline; my @b = @{$db->{data}->{$pkg}->{STATUS}->[$i-1]}; while (scalar @a) { next if (shift(@a) eq shift(@b)); $ok = 0; last; } $linefound = 1 if $ok; } next unless $linefound; my @b = @{$db->{data}->{$pkg}->{STATUS}->[$i-1]}; if ( ($b[0] eq $type) and ($b[1] eq $file)) { $found = 1; splice @{$db->{data}->{$pkg}->{STATUS}}, $i-1, 1; } } } print "Cannot del_status, $type/$file not found in package $pkg\n" unless $found; } if (scalar @{$db->{data}->{$pkg}->{STATUS}} == 0) { $db->clear_pkg($pkg); } } =item get_header Returns the value of the specified header =cut sub get_header { # print "get $_[1] -> ".($_[0]->{data}->{''}->{$_[1]})."\n"; return $_[0]->{data}->{''}->{$_[1]}; } =item set_header Sets the specified header to the specified value =cut sub set_header { # print "set $_[1] -> $_[2]\n"; $_[0]->{data}->{''}->{$_[1]} = $_[2]; } =item get_date Returns date of generation =cut sub get_date { return get_header($_[0],'Date'); } =item set_date Sets the date of generation =cut sub set_date { set_header($_[0],'Date',$_[1]); } =item clean-db clean_db cleans the database by removing data for a document whose status is 'done' for more than three days. =cut sub clean_db($) { my $db = shift; my $now = time; my $offset = 60 * 60 * 24 * 3; # 3 days in seconds foreach my $pkg (sort( grep { $db->has_status($_) } $db->list_packages())) { READ_LINES: if ($db->has_package($pkg)) { # The package may have disapeared after del_status foreach my $statusline (@{$db->status($pkg)}) { my ($type, $file, $date, $status_from_db, $translator, $list, $url, $bug_nb) = @{$statusline}; warn "$pkg\:$type\:$file does not specify the status\n" unless defined $status_from_db; next unless defined $status_from_db; next unless ($status_from_db eq 'done' or $status_from_db eq 'fix'); my $date_done = $date; $date_done =~ s/ .*//; $date_done =~ m/(\d\d\d\d)-(\d\d)-(\d+)/; my $time_done = timelocal(0,0,0, $3,$2-1,$1); if ($now - $time_done > $offset) { print "Remove ".($bug_nb?"#$bug_nb":"DONE")." about the $type of $pkg because it's done since more than 3 days\n"; $db->del_status($pkg, $type, $file, $statusline); goto READ_LINES; } } } } } =back =head2 DATA MANIPULATION Data about packages can be classified within scalar values (C, C, C
, C, C, C, C, C), arrays (C, C, C), and arrays of arrays (C, C, C, C, C, C, C and C). Each field has a method with the same name to get and set it, e.g. $section = $l10n_db->section($pkg); $l10n_db->section($pkg, "libs"); The first line get the section associated with the package in C<$pkg>, whereas the second set it to C. Two other methods are also defined to access those data, by prefixing field name by C and C. The former is used to ask whether this field is defined in database, and the latter appends values for arrays or arrays of arrays. if ($l10n_db->has_templates($pkg)) { print "Package $pkg has Debconf templates\n"; } $l10n_db->add_po($pkg, 'po/fr.po', 'fr', '42t0f0u', 'po/adduser_3.42_po_fr.po'); =head1 AUTHOR Copyright (C) 2001-2004 Denis Barbier Copyright (C) 2004 Martin Quinson 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 2 of the License, or (at your option) any later version. =cut 1; dl10n-3.00/lib/Locale/0000755000000000000000000000000011544665455011224 5ustar dl10n-3.00/lib/Locale/Constants.pm0000644000000000000000000000333111544665455013536 0ustar package Locale::Constants; # # Locale::Constants - defined constants for identifying codesets # # $Id: Constants.pm 71 2004-08-26 18:00:17Z barbier $ # use strict; require Exporter; use vars qw($VERSION @ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(LOCALE_CODE_ALPHA_2 LOCALE_CODE_ALPHA_3 LOCALE_CODE_NUMERIC LOCALE_CODE_DEFAULT); use constant LOCALE_CODE_ALPHA_2 => 1; use constant LOCALE_CODE_ALPHA_3 => 2; use constant LOCALE_CODE_NUMERIC => 3; use constant LOCALE_CODE_DEFAULT => LOCALE_CODE_ALPHA_2; 1; __END__ =head1 NAME Locale::Constants - constants for Locale codes =head1 SYNOPSIS use Locale::Constants; $codeset = LOCALE_CODE_ALPHA_2; =head1 DESCRIPTION B defines symbols which are used in the three modules from the Locale-Codes distribution: Locale::Language Locale::Country Locale::Currency B at the moment only Locale::Country supports more than one code set. The symbols defined are used to specify which codes you want to be used: LOCALE_CODE_ALPHA_2 LOCALE_CODE_ALPHA_3 LOCALE_CODE_NUMERIC You shouldn't have to C this module directly yourself - it is used by the three Locale modules, which in turn export the symbols. =head1 KNOWN BUGS AND LIMITATIONS None at the moment. =head1 SEE ALSO =over 4 =item Locale::Language Codes for identification of languages. =item Locale::Country Codes for identification of countries. =item Locale::Currency Codes for identification of currencies and funds. =back =head1 AUTHOR Neil Bowers Eneilb@cre.canon.co.ukE =head1 COPYRIGHT Copyright (C) 2001, Canon Research Centre Europe (CRE). This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut dl10n-3.00/lib/Locale/Country.pm0000644000000000000000000004234411544665455013234 0ustar #----------------------------------------------------------------------- =head1 NAME Locale::Country - ISO codes for country identification (ISO 3166) =head1 SYNOPSIS use Locale::Country; $country = code2country('jp'); # $country gets 'Japan' $code = country2code('Norway'); # $code gets 'no' @codes = all_country_codes(); @names = all_country_names(); # add "uk" as a pseudo country code for United Kingdom Locale::Country::_alias_code('uk' => 'gb'); =cut #----------------------------------------------------------------------- package Locale::Country; use strict; require 5.002; #----------------------------------------------------------------------- =head1 DESCRIPTION The C module provides access to the ISO codes for identifying countries, as defined in ISO 3166. You can either access the codes via the L (described below), or with the two functions which return lists of all country codes or all country names. There are three different code sets you can use for identifying countries: =over 4 =item B Two letter codes, such as 'tv' for Tuvalu. This code set is identified with the symbol C. =item B Three letter codes, such as 'brb' for Barbados. This code set is identified with the symbol C. =item B Numeric codes, such as 064 for Bhutan. This code set is identified with the symbol C. =back All of the routines take an optional additional argument which specifies the code set to use. If not specified, it defaults to the two-letter codes. This is partly for backwards compatibility (previous versions of this module only supported the alpha-2 codes), and partly because they are the most widely used codes. The alpha-2 and alpha-3 codes are not case-dependent, so you can use 'BO', 'Bo', 'bO' or 'bo' for Bolivia. When a code is returned by one of the functions in this module, it will always be lower-case. =cut #----------------------------------------------------------------------- require Exporter; use Carp; use Locale::Constants; #----------------------------------------------------------------------- # Public Global Variables #----------------------------------------------------------------------- use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); $VERSION = sprintf("%s", q$Revision: 1047 $ =~ /Revision:\s*(.*)/); @ISA = qw(Exporter); @EXPORT = qw(code2country country2code all_country_codes all_country_names country_code2code LOCALE_CODE_ALPHA_2 LOCALE_CODE_ALPHA_3 LOCALE_CODE_NUMERIC); #----------------------------------------------------------------------- # Private Global Variables #----------------------------------------------------------------------- my $CODES = []; my $COUNTRIES = []; #======================================================================= =head1 CONVERSION ROUTINES There are three conversion routines: C, C, and C. =over 8 =item code2country( CODE, [ CODESET ] ) This function takes a country code and returns a string which contains the name of the country identified. If the code is not a valid country code, as defined by ISO 3166, then C will be returned: $country = code2country('fi'); =item country2code( STRING, [ CODESET ] ) This function takes a country name and returns the corresponding country code, if such exists. If the argument could not be identified as a country name, then C will be returned: $code = country2code('Norway', LOCALE_CODE_ALPHA_3); # $code will now be 'nor' The case of the country name is not important. See the section L below. =item country_code2code( CODE, CODESET, CODESET ) This function takes a country code from one code set, and returns the corresponding code from another code set. $alpha2 = country_code2code('fin', LOCALE_CODE_ALPHA_3 => LOCALE_CODE_ALPHA_2); # $alpha2 will now be 'fi' If the code passed is not a valid country code in the first code set, or if there isn't a code for the corresponding country in the second code set, then C will be returned. =back =cut #======================================================================= sub code2country { my $code = shift; my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT; return undef unless defined $code; #------------------------------------------------------------------- # Make sure the code is in the right form before we use it # to look up the corresponding country. # We have to sprintf because the codes are given as 3-digits, # with leading 0's. Eg 052 for Barbados. #------------------------------------------------------------------- if ($codeset == LOCALE_CODE_NUMERIC) { return undef if ($code =~ /\D/); $code = sprintf("%.3d", $code); } else { $code = lc($code); } if (exists $CODES->[$codeset]->{$code}) { return $CODES->[$codeset]->{$code}; } else { #--------------------------------------------------------------- # no such country code! #--------------------------------------------------------------- return undef; } } sub country2code { my $country = shift; my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT; return undef unless defined $country; $country = lc($country); if (exists $COUNTRIES->[$codeset]->{$country}) { return $COUNTRIES->[$codeset]->{$country}; } else { #--------------------------------------------------------------- # no such country! #--------------------------------------------------------------- return undef; } } sub country_code2code { (@_ == 3) or croak "country_code2code() takes 3 arguments!"; my $code = shift; my $inset = shift; my $outset = shift; my $outcode = shift; my $country; return undef if $inset == $outset; $country = code2country($code, $inset); return undef if not defined $country; $outcode = country2code($country, $outset); return $outcode; } #======================================================================= =head1 QUERY ROUTINES There are two function which can be used to obtain a list of all codes, or all country names: =over 8 =item C Returns a list of all two-letter country codes. The codes are guaranteed to be all lower-case, and not in any particular order. =item C Returns a list of all country names for which there is a corresponding country code in the specified code set. The names are capitalised, and not returned in any particular order. Not all countries have alpha-3 and numeric codes - some just have an alpha-2 code, so you'll get a different number of countries depending on which code set you specify. =back =cut #======================================================================= sub all_country_codes { my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT; return keys %{ $CODES->[$codeset] }; } sub all_country_names { my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT; return values %{ $CODES->[$codeset] }; } #----------------------------------------------------------------------- =head1 CODE ALIASING This module supports a semi-private routine for specifying two letter code aliases. Locale::Country::_alias_code( ALIAS => CODE [, CODESET ] ) This feature was added as a mechanism for handling a "uk" code. The ISO standard says that the two-letter code for "United Kingdom" is "gb", whereas domain names are all .uk. By default the module does not understand "uk", since it is implementing an ISO standard. If you would like 'uk' to work as the two-letter code for United Kingdom, use the following: use Locale::Country; Locale::Country::_alias_code('uk' => 'gb'); With this code, both "uk" and "gb" are valid codes for United Kingdom, with the reverse lookup returning "uk" rather than the usual "gb". =cut #----------------------------------------------------------------------- sub _alias_code { my $alias = shift; my $real = shift; my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT; my $country; if (not exists $CODES->[$codeset]->{$real}) { carp "attempt to alias \"$alias\" to unknown country code \"$real\"\n"; return undef; } $country = $CODES->[$codeset]->{$real}; $CODES->[$codeset]->{$alias} = $country; $COUNTRIES->[$codeset]->{"\L$country"} = $alias; return $alias; } #----------------------------------------------------------------------- =head1 EXAMPLES The following example illustrates use of the C function. The user is prompted for a country code, and then told the corresponding country name: $| = 1; # turn off buffering print "Enter country code: "; chop($code = ); $country = code2country($code, LOCALE_CODE_ALPHA_2); if (defined $country) { print "$code = $country\n"; } else { print "'$code' is not a valid country code!\n"; } =head1 DOMAIN NAMES Most top-level domain names are based on these codes, but there are certain codes which aren't. If you are using this module to identify country from hostname, your best bet is to preprocess the country code. For example, B, B, B and friends would map to B; B would map to B. Any others? =head1 KNOWN BUGS AND LIMITATIONS =over 4 =item * When using C, the country name must currently appear exactly as it does in the source of the module. For example, country2code('United States') will return B, as expected. But the following will all return C: country2code('United States of America') country2code('Great Britain') country2code('U.S.A.') If there's need for it, a future version could have variants for country names. =item * In the current implementation, all data is read in when the module is loaded, and then held in memory. A lazy implementation would be more memory friendly. =back =head1 SEE ALSO =over 4 =item Locale::Language ISO two letter codes for identification of language (ISO 639). =item Locale::Currency ISO three letter codes for identification of currencies and funds (ISO 4217). =item ISO 3166 The ISO standard which defines these codes. =item http://www.din.de/gremien/nas/nabd/iso3166ma/ Official home page for ISO 3166 =item http://www.egt.ie/standards/iso3166/iso3166-1-en.html Another useful, but not official, home page. =item http://www.cia.gov/cia/publications/factbook/docs/app-f.html An appendix in the CIA world fact book which lists country codes as defined by ISO 3166, FIPS 10-4, and internet domain names. =back =head1 AUTHOR Neil Bowers Eneilb@cre.canon.co.ukE =head1 COPYRIGHT Copyright (c) 1997-2001 Canon Research Centre Europe (CRE). This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut #----------------------------------------------------------------------- #======================================================================= # initialisation code - stuff the DATA into the ALPHA2 hash #======================================================================= { my ($alpha2, $alpha3, $numeric); my $country; while () { next unless /\S/; chop; ($alpha2, $alpha3, $numeric, $country) = split(/:/, $_, 4); $CODES->[LOCALE_CODE_ALPHA_2]->{$alpha2} = $country; $COUNTRIES->[LOCALE_CODE_ALPHA_2]->{"\L$country"} = $alpha2; if ($alpha3) { $CODES->[LOCALE_CODE_ALPHA_3]->{$alpha3} = $country; $COUNTRIES->[LOCALE_CODE_ALPHA_3]->{"\L$country"} = $alpha3; } if ($numeric) { $CODES->[LOCALE_CODE_NUMERIC]->{$numeric} = $country; $COUNTRIES->[LOCALE_CODE_NUMERIC]->{"\L$country"} = $numeric; } } } 1; __DATA__ ad:and:020:Andorra ae:are:784:United Arab Emirates af:afg:004:Afghanistan ag:atg:028:Antigua and Barbuda ai:aia:660:Anguilla al:alb:008:Albania am:arm:051:Armenia an:ant:530:Netherlands Antilles ao:ago:024:Angola aq:::Antarctica ar:arg:032:Argentina as:asm:016:American Samoa at:aut:040:Austria au:aus:036:Australia aw:abw:533:Aruba az:aze:031:Azerbaijan ba:bih:070:Bosnia and Herzegovina bb:brb:052:Barbados bd:bgd:050:Bangladesh be:bel:056:Belgium bf:bfa:854:Burkina Faso bg:bgr:100:Bulgaria bh:bhr:048:Bahrain bi:bdi:108:Burundi bj:ben:204:Benin bm:bmu:060:Bermuda bn:brn:096:Brunei Darussalam bo:bol:068:Bolivia br:bra:076:Brazil bs:bhs:044:Bahamas bt:btn:064:Bhutan bv:::Bouvet Island bw:bwa:072:Botswana by:blr:112:Belarus bz:blz:084:Belize ca:can:124:Canada cc:::Cocos (Keeling) Islands cd:cod:180:Congo, The Democratic Republic of the cf:caf:140:Central African Republic cg:cog:178:Congo ch:che:756:Switzerland ci:civ:384:Cote D'Ivoire ck:cok:184:Cook Islands cl:chl:152:Chile cm:cmr:120:Cameroon cn:chn:156:China co:col:170:Colombia cr:cri:188:Costa Rica cu:cub:192:Cuba cv:cpv:132:Cape Verde cx:::Christmas Island cy:cyp:196:Cyprus cz:cze:203:Czech Republic de:deu:276:Germany dj:dji:262:Djibouti dk:dnk:208:Denmark dm:dma:212:Dominica do:dom:214:Dominican Republic dz:dza:012:Algeria ec:ecu:218:Ecuador ee:est:233:Estonia eg:egy:818:Egypt eh:esh:732:Western Sahara er:eri:232:Eritrea es:esp:724:Spain et:eth:231:Ethiopia fi:fin:246:Finland fj:fji:242:Fiji fk:flk:238:Falkland Islands (Malvinas) fm:fsm:583:Micronesia, Federated States of fo:fro:234:Faroe Islands fr:fra:250:France fx:::France, Metropolitan ga:gab:266:Gabon gb:gbr:826:United Kingdom gd:grd:308:Grenada ge:geo:268:Georgia gf:guf:254:French Guiana gh:gha:288:Ghana gi:gib:292:Gibraltar gl:grl:304:Greenland gm:gmb:270:Gambia gn:gin:324:Guinea gp:glp:312:Guadeloupe gq:gnq:226:Equatorial Guinea gr:grc:300:Greece gs:::South Georgia and the South Sandwich Islands gt:gtm:320:Guatemala gu:gum:316:Guam gw:gnb:624:Guinea-Bissau gy:guy:328:Guyana hk:hkg:344:Hong Kong hm:::Heard Island and McDonald Islands hn:hnd:340:Honduras hr:hrv:191:Croatia ht:hti:332:Haiti hu:hun:348:Hungary id:idn:360:Indonesia ie:irl:372:Ireland il:isr:376:Israel in:ind:356:India io:::British Indian Ocean Territory iq:irq:368:Iraq ir:irn:364:Iran, Islamic Republic of is:isl:352:Iceland it:ita:380:Italy jm:jam:388:Jamaica jo:jor:400:Jordan jp:jpn:392:Japan ke:ken:404:Kenya kg:kgz:417:Kyrgyzstan kh:khm:116:Cambodia ki:kir:296:Kiribati km:com:174:Comoros kn:kna:659:Saint Kitts and Nevis kp:prk:408:Korea, Democratic People's Republic of kr:kor:410:Korea, Republic of kw:kwt:414:Kuwait ky:cym:136:Cayman Islands kz:kaz:398:Kazakstan la:lao:418:Lao People's Democratic Republic lb:lbn:422:Lebanon lc:lca:662:Saint Lucia li:lie:438:Liechtenstein lk:lka:144:Sri Lanka lr:lbr:430:Liberia ls:lso:426:Lesotho lt:ltu:440:Lithuania lu:lux:442:Luxembourg lv:lva:428:Latvia ly:lby:434:Libyan Arab Jamahiriya ma:mar:504:Morocco mc:mco:492:Monaco md:mda:498:Moldova, Republic of mg:mdg:450:Madagascar mh:mhl:584:Marshall Islands mk:mkd:807:Macedonia, the Former Yugoslav Republic of ml:mli:466:Mali mm:mmr:104:Myanmar mn:mng:496:Mongolia mo:mac:446:Macau mp:mnp:580:Northern Mariana Islands mq:mtq:474:Martinique mr:mrt:478:Mauritania ms:msr:500:Montserrat mt:mlt:470:Malta mu:mus:480:Mauritius mv:mdv:462:Maldives mw:mwi:454:Malawi mx:mex:484:Mexico my:mys:458:Malaysia mz:moz:508:Mozambique na:nam:516:Namibia nc:ncl:540:New Caledonia ne:ner:562:Niger nf:nfk:574:Norfolk Island ng:nga:566:Nigeria ni:nic:558:Nicaragua nl:nld:528:Netherlands no:nor:578:Norway np:npl:524:Nepal nr:nru:520:Nauru nu:niu:570:Niue nz:nzl:554:New Zealand om:omn:512:Oman pa:pan:591:Panama pe:per:604:Peru pf:pyf:258:French Polynesia pg:png:598:Papua New Guinea ph:phl:608:Philippines pk:pak:586:Pakistan pl:pol:616:Poland pm:spm:666:Saint Pierre and Miquelon pn:pcn:612:Pitcairn pr:pri:630:Puerto Rico ps:pse:275:Palestinian Territory, Occupied pt:prt:620:Portugal pw:plw:585:Palau py:pry:600:Paraguay qa:qat:634:Qatar re:reu:638:Reunion ro:rom:642:Romania ru:rus:643:Russian Federation rw:rwa:646:Rwanda sa:sau:682:Saudi Arabia sb:slb:090:Solomon Islands sc:syc:690:Seychelles sd:sdn:736:Sudan se:swe:752:Sweden sg:sgp:702:Singapore sh:shn:654:Saint Helena si:svn:705:Slovenia sj:sjm:744:Svalbard and Jan Mayen sk:svk:703:Slovakia sl:sle:694:Sierra Leone sm:smr:674:San Marino sn:sen:686:Senegal so:som:706:Somalia sr:sur:740:Suriname st:stp:678:Sao Tome and Principe sv:slv:222:El Salvador sy:syr:760:Syrian Arab Republic sz:swz:748:Swaziland tc:tca:796:Turks and Caicos Islands td:tcd:148:Chad tf:::French Southern Territories tg:tgo:768:Togo th:tha:764:Thailand tj:tjk:762:Tajikistan tk:tkl:772:Tokelau tm:tkm:795:Turkmenistan tn:tun:788:Tunisia to:ton:776:Tonga tp:tmp:626:East Timor tr:tur:792:Turkey tt:tto:780:Trinidad and Tobago tv:tuv:798:Tuvalu tw:twn:158:Taiwan, Province of China tz:tza:834:Tanzania, United Republic of ua:ukr:804:Ukraine ug:uga:800:Uganda um:::United States Minor Outlying Islands us:usa:840:United States uy:ury:858:Uruguay uz:uzb:860:Uzbekistan va:vat:336:Holy See (Vatican City State) vc:vct:670:Saint Vincent and the Grenadines ve:ven:862:Venezuela vg:vgb:092:Virgin Islands, British vi:vir:850:Virgin Islands, U.S. vn:vnm:704:Vietnam vu:vut:548:Vanuatu wf:wlf:876:Wallis and Futuna ws:wsm:882:Samoa ye:yem:887:Yemen yt:::Mayotte yu:yug:891:Yugoslavia za:zaf:710:South Africa zm:zmb:894:Zambia zr:::Zaire zw:zwe:716:Zimbabwe dl10n-3.00/lib/Locale/Language.pm0000644000000000000000000002063511544665455013313 0ustar #----------------------------------------------------------------------- =head1 NAME Locale::Language - ISO two letter codes for language identification (ISO 639) =head1 SYNOPSIS use Locale::Language; $lang = code2language('en'); # $lang gets 'English' $code = language2code('French'); # $code gets 'fr' @codes = all_language_codes(); @names = all_language_names(); =cut #----------------------------------------------------------------------- package Locale::Language; use strict; require 5.002; #----------------------------------------------------------------------- =head1 DESCRIPTION The C module provides access to the ISO two-letter codes for identifying languages, as defined in ISO 639. You can either access the codes via the L (described below), or with the two functions which return lists of all language codes or all language names. =cut #----------------------------------------------------------------------- require Exporter; #----------------------------------------------------------------------- # Public Global Variables #----------------------------------------------------------------------- use vars qw($VERSION @ISA @EXPORT); $VERSION = sprintf("%s", q$Revision: 1923 $ =~ /Revision:\s*(.*)/); @ISA = qw(Exporter); @EXPORT = qw(&code2language &language2code &all_language_codes &all_language_names ); #----------------------------------------------------------------------- # Private Global Variables #----------------------------------------------------------------------- my %CODES = (); my %LANGUAGES = (); #======================================================================= =head1 CONVERSION ROUTINES There are two conversion routines: C and C. =over 8 =item code2language() This function takes a two letter language code and returns a string which contains the name of the language identified. If the code is not a valid language code, as defined by ISO 639, then C will be returned. $lang = code2language($code); =item language2code() This function takes a language name and returns the corresponding two letter language code, if such exists. If the argument could not be identified as a language name, then C will be returned. $code = language2code('French'); The case of the language name is not important. See the section L below. =back =cut #======================================================================= sub code2language { my $code = shift; return undef unless defined $code; $code = lc($code); if (exists $CODES{$code}) { return $CODES{$code}; } else { #--------------------------------------------------------------- # no such language code! #--------------------------------------------------------------- return undef; } } sub language2code { my $lang = shift; return undef unless defined $lang; $lang = lc($lang); if (exists $LANGUAGES{$lang}) { return $LANGUAGES{$lang}; } else { #--------------------------------------------------------------- # no such language! #--------------------------------------------------------------- return undef; } } #======================================================================= =head1 QUERY ROUTINES There are two function which can be used to obtain a list of all language codes, or all language names: =over 8 =item C Returns a list of all two-letter language codes. The codes are guaranteed to be all lower-case, and not in any particular order. =item C Returns a list of all language names for which there is a corresponding two-letter language code. The names are capitalised, and not returned in any particular order. =back =cut #======================================================================= sub all_language_codes { return keys %CODES; } sub all_language_names { return values %CODES; } #----------------------------------------------------------------------- =head1 EXAMPLES The following example illustrates use of the C function. The user is prompted for a language code, and then told the corresponding language name: $| = 1; # turn off buffering print "Enter language code: "; chop($code = ); $lang = code2language($code); if (defined $lang) { print "$code = $lang\n"; } else { print "'$code' is not a valid language code!\n"; } =head1 KNOWN BUGS AND LIMITATIONS =over 4 =item * In the current implementation, all data is read in when the module is loaded, and then held in memory. A lazy implementation would be more memory friendly. =item * Currently just supports the two letter language codes - there are also three-letter codes, and numbers. Would these be of any use to anyone? =back =head1 SEE ALSO =over 4 =item Locale::Country ISO codes for identification of country (ISO 3166). Supports 2-letter, 3-letter, and numeric country codes. =item Locale::Currency ISO three letter codes for identification of currencies and funds (ISO 4217). =item ISO 639:1988 (E/F) Code for the representation of names of languages. =item http://lcweb.loc.gov/standards/iso639-2/langhome.html Home page for ISO 639-2 =back =head1 AUTHOR Neil Bowers Eneilb@cre.canon.co.ukE =head1 COPYRIGHT Copyright (c) 1997-2001 Canon Research Centre Europe (CRE). This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut #----------------------------------------------------------------------- #======================================================================= # initialisation code - stuff the DATA into the CODES hash #======================================================================= { my $code; my $language; while () { next unless /\S/; chop; ($code, $language) = split(/:/, $_, 2); $CODES{$code} = $language; $LANGUAGES{"\L$language"} = $code; } } 1; __DATA__ aa:Afar ab:Abkhazian ae:Avestan af:Afrikaans am:Amharic an:Aragonese ang:Old English ar:Arabic as:Assamese ast:Asturian ay:Aymara az:Azerbaijani ba:Bashkir be:Belarusian bem:Bemba (Zambia) bg:Bulgarian bh:Bihari bi:Bislama bn:Bengali bo:Tibetan br:Breton bs:Bosnian byn:Blin ca:Catalan ce:Chechen ch:Chamorro co:Corsican crh:Crimean Tatar cs:Czech csb:Kashubian cu:Church Slavic cv:Chuvash cy:Welsh da:Danish de:German dz:Dzongkha el:Greek en:English eo:Esperanto es:Spanish et:Estonian eu:Basque fa:Persian fi:Finnish fil:Filipino fj:Fijian fo:Faeroese fr:French frp:Franco-Provenal fur:Friulian fy:Frisian ga:Irish gd:Gaelic (Scots) gez:Ge'ez gl:Gallegan gn:Guarani gu:Gujarati gv:Manx ha:Hausa he:Hebrew hi:Hindi hne:Chhattisgarhi ho:Hiri Motu hr:Croatian ht:Kreyol hu:Hungarian hy:Armenian hz:Herero ia:Interlingua id:Indonesian ie:Interlingue ig:Igbo ik:Inupiaq io:Ido is:Icelandic it:Italian iu:Inuktitut ja:Japanese jv:Javanese ka:Georgian kab:Kabyle ki:Kikuyu kj:Kuanyama kk:Kazakh kl:Kalaallisut km:Khmer kn:Kannada ko:Korean ks:Kashmiri ku:Kurdish kv:Komi kw:Cornish ky:Kirghiz la:Latin lb:Letzeburgesch lg:Luganda li:Limburgish ln:Lingala lo:Lao lt:Lithuanian lv:Latvian mai:Maithili mal:Malayalam mg:Malagasy mh:Marshall mi:Maori mk:Macedonian ml:Malayalam mn:Mongolian mo:Moldavian mr:Marathi ms:Malay mt:Maltese mus:Creek my:Burmese na:Nauru nb:Norwegian Bokml nd:Ndebele, North nds:Low German (Low Saxon) ne:Nepali new:Newari (Nepal Bhasa) ng:Ndonga nl:Dutch nn:Norwegian Nynorsk no:Norwegian nr:Ndebele, South nso:Northern Sotho nv:Navajo ny:Chichewa; Nyanja oc:Occitan (post 1500) om:Oromo or:Oriya os:Ossetian; Ossetic pa:Panjabi pi:Pali pms:Piedmontese pl:Polish ps:Pushto pt:Portuguese qu:Quechua rm:Rhaeto-Romance rn:Rundi ro:Romanian ru:Russian rw:Kinyarwanda sa:Sanskrit sc:Sardinian sd:Sindhi se:Sami sg:Sango si:Sinhala sk:Slovak sl:Slovenian sm:Samoan sn:Shona so:Somali sq:Albanian sr:Serbian ss:Swati st:Sotho su:Sundanese sv:Swedish sw:Swahili ta:Tamil te:Telugu tg:Tajik th:Thai ti:Tigrinya tig:Tigre tk:Turkmen tl:Tagalog tlh:Klingon (tlhIngan-Hol) tn:Tswana to:Tonga tr:Turkish ts:Tsonga tt:Tatar tw:Twi ug:Uighur uk:Ukrainian ur:Urdu uz:Uzbek ve:Venda vi:Vietnamese vo:Volapk wal:Walaita wo:Wolof xh:Xhosa yi:Yiddish yo:Yoruba za:Zhuang zh:Chinese zu:Zulu dl10n-3.00/dl10n-nmu0000755000000000000000000002366711704570256010726 0ustar #!/usr/bin/perl -w # dl10n-nmu -- Scoring packages with long-standing po-debconf bugs # # Copyright (C) 2006 Thomas Huriaux # Copyright (C) 2011 David Prévot # # 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 2 of the License, or # (at your option) any later version. use strict; use Debian::L10n::Db; use SOAP::Lite; use POSIX qw(strftime); my $generation_date = strftime('%a, %d %b %Y %H:%M:%S %z', gmtime); # TODO: add an option my $DB_FILE="/srv/i18n.debian.net/www/debian-l10n-material/data/unstable.gz"; my $POPCON="./data/by_inst"; print "Read the database..."; my $data = Debian::L10n::Db->new(); $data->read($DB_FILE); print " done.\n"; my $packages = {}; my $bugs = {}; my $comments = {}; $comments->{removed} = "not in unstable"; $comments->{switch} = "not using po-debconf"; $comments->{normal} = " "; $comments->{nodebconf} = "not using debconf"; print "Starting SOAP query... "; my $soap = SOAP::Lite->uri('Debbugs/SOAP')->proxy('http://bugs.debian.org/cgi-bin/soap.cgi') or die "failed: $!\n"; my $soap_bugs = $soap->get_bugs(tag=>'l10n')->result or die "failed: $!\n"; my $soap_status = $soap->get_status($soap_bugs)->result() or die "failed: $!\n"; print "done.\n"; my $pop = {}; open (POPCON, $POPCON); while (my $line = ) { if ($line =~ /^(\d+)\s+(\S+)\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+$/) { $pop->{$2} = (2 - $1 / 10000); } } foreach my $bug_nb (@$soap_bugs) { next if $soap_status->{$bug_nb}->{done}; next if $soap_status->{$bug_nb}->{archived}; my $pkg = $soap_status->{$bug_nb}->{source}; $pkg = $soap_status->{$bug_nb}->{package} unless (defined $pkg and $pkg ne ""); my $date = $soap_status->{$bug_nb}->{date}; #these packages are skipped in the database next if ($pkg =~ /(kde-i18n|wordtrans|kernel-image-2\.4\.27-m68k|manpages|debian-med|pptpd)/); my @tags = $soap_status->{$bug_nb}->{tags}; next if (grep ( /^fixed$/, @tags )); my $bug_title = $soap_status->{$bug_nb}->{subject}; $bugs->{$bug_nb} = $bug_title; $packages->{$pkg}->{score} = 0 unless (defined $packages->{$pkg}); #search for debconf templates bug, adding Clytie's and Daniel's tests. if (($bug_title =~ /(debconf|template|INTL:vi$)/i) and ($bug_title !~ /Swedish PO-template translation/)) { unless ($pop->{$pkg}) { print "$pkg has no popcon score (maybe an udeb), use a low score 1\n"; $pop->{$pkg} = 1; } my $coeff = 1; $coeff = 5 if ($bug_title =~ /Please switch to gettext-based debconf template/); if (not $bug_title eq "gdm does not use gettext-based debconf templates; see README.Debian") { $packages->{$pkg}->{score} += ((time - $date) / (60 * 60 * 24 * 7) * $coeff * $pop->{$pkg}); } push (@{$packages->{$pkg}->{debconf}}, $bug_nb); } else { push (@{$packages->{$pkg}->{l10n}}, $bug_nb); } } my $orphaned = {}; $soap = SOAP::Lite->uri('Debbugs/SOAP')->proxy('http://bugs.debian.org/cgi-bin/soap.cgi') or die "Unable to connect to SOAP: $!\n"; $soap_bugs = $soap->get_bugs( package=>'wnpp')->result; $soap_status = $soap->get_status($soap_bugs)->result() or die; foreach my $bug_nb (@$soap_bugs) { my $bug_title = $soap_status->{$bug_nb}->{subject}; next unless defined $bug_title; # Bug sent without subject (#537751) if ($bug_title =~ /^O: ([+.a-z0-9-]+) -- .+$/) { $orphaned->{$1} = 1; } } my $removed = {}; $soap = SOAP::Lite->uri('Debbugs/SOAP')->proxy('http://bugs.debian.org/cgi-bin/soap.cgi') or die "Unable to connect to SOAP: $!\n"; $soap_bugs = $soap->get_bugs( package=>'ftp.debian.org')->result; $soap_status = $soap->get_status($soap_bugs)->result() or die; foreach my $bug_nb (@$soap_bugs) { my $bug_title = $soap_status->{$bug_nb}->{subject}; next unless defined $bug_title; # Bug sent without subject (#537751) if ($bug_title =~ /^RM: ([+.a-z0-9-]+) -- .+$/) { $removed->{$1} = 1; } } foreach my $pkg (keys %$packages) { next if ($packages->{$pkg} == 0); $packages->{$pkg}->{maintainer} = 'Orphaned' if $orphaned->{$pkg}; $packages->{$pkg}->{maintainer} = 'Pending for removal' if $removed->{$pkg}; if (not $data->has_package($pkg)) { $packages->{$pkg}->{class} = "removed"; $packages->{$pkg}->{maintainer} = "none"; } elsif ($data->has_templates($pkg)) { $packages->{$pkg}->{class} = "switch"; } elsif ($data->has_podebconf($pkg)) { $packages->{$pkg}->{class} = "normal"; } else { $packages->{$pkg}->{class} = "nodebconf"; } $packages->{$pkg}->{maintainer} = $data->maintainer($pkg) unless defined $packages->{$pkg}->{maintainer}; if (defined $packages->{$pkg}->{maintainer}) { $packages->{$pkg}->{maintainer} =~ s/{$pkg}->{maintainer} =~ s/>/>/g; } else { $packages->{$pkg}->{maintainer} = "(unknown)"; } } #TODO: refactor printing code #printing stuffs ###BY PACKAGE open (FILE, ">html/nmu_bypackage.html"); print FILE "\n"; print FILE "\n"; print FILE "\n"; print FILE " Debian localization radar\n"; print FILE " \n"; print FILE " \n"; print FILE "\n"; print FILE "\n"; print FILE "\"Score"; print FILE "
Languagepodebconfpopo4a
$lang".graph_stats($score{$pkg}{"podebconf"}{$lang})."".graph_stats($score{$pkg}{"po"}{$lang})."".graph_stats($score{$pkg}{"po4a"}{$lang})."
Package Type File Translator Status Date Message Bug
$pkg $type $file $translator $status $sdate $list $bug_nb
Package Type File Translator Status Date Message Bug
$pkg $type $file $translator $status $date $list $sbug_nb
Package Type File Translator Status Date Message Bug

$translator
$pkg $type $file$status $date $list $bug_nb
Package Type File Translator Status Date Message Bug

$type
$pkg $type $file$status $date $list $bug_nb
Package Type File Translator Status Date Message Bug

$status
$pkg $type $file $translator $status $date $list $bug_nb
Package Type File Translator Status Date Message Bug

$pkg
$pkg $type $file$status $date $list $bug_nb
\n"; print FILE " \n"; open (DATABASE, ">data/status.nmu"); foreach my $pkg (sort { $packages->{$b}->{score} <=> $packages->{$a}->{score} } keys %$packages) { next if ($packages->{$pkg}->{score} == 0); print DATABASE "Package: $pkg\n"; print DATABASE "Score: ".int ($packages->{$pkg}->{score})."\n"; print FILE " {$pkg}->{class}."\">\n"; print FILE " \n"; print FILE " \n"; print FILE " \n"; print DATABASE "Maintainer: ".$packages->{$pkg}->{maintainer}."\n"; print DATABASE "Class: ".$packages->{$pkg}->{class}."\n"; print FILE " \n"; print FILE " "; print FILE " \n"; print DATABASE "\n"; } print FILE "
PackageScoreL10n bugsMaintainerComment
$pkg".int ($packages->{$pkg}->{score})."\n"; if (defined @{$packages->{$pkg}->{debconf}}) { print DATABASE "Debconf: "; print FILE " po-debconf bugs:\n"; print FILE "
    \n"; foreach my $bug (@{$packages->{$pkg}->{debconf}}) { print FILE "
  • #$bug -- $bugs->{$bug}
    • \n"; print DATABASE "$bug "; } print DATABASE "\n"; print FILE "
\n"; } if (defined @{$packages->{$pkg}->{l10n}}) { print FILE " other l10n bugs:\n"; print FILE "
    \n"; print DATABASE "L10n: "; foreach my $bug (@{$packages->{$pkg}->{l10n}}) { print FILE "
  • #$bug -- $bugs->{$bug}
    • \n"; print DATABASE "$bug "; } print DATABASE "\n"; print FILE "
\n"; } print FILE " 		".$packages->{$pkg}->{maintainer}."".$comments->{$packages->{$pkg}->{class}}."
\n"; print FILE "
\n"; print FILE "

Generated on $generation_date

\n"; print FILE "

Comments: Debian L10N Development Team

\n"; print FILE "\n"; print FILE "\n"; close (FILE); ###BY MAINTAINER open (FILE, ">html/nmu_maintainer.html"); print FILE "\n"; print FILE "\n"; print FILE "\n"; print FILE " Debian localization radar\n"; print FILE " \n"; print FILE " \n"; print FILE "\n"; print FILE "\n"; print FILE "\"Score"; print FILE " \n"; print FILE " \n"; foreach my $pkg (sort { $packages->{$a}->{maintainer} cmp $packages->{$b}->{maintainer} } keys %$packages) { next if ($packages->{$pkg}->{score} == 0); print FILE " {$pkg}->{class}."\">\n"; print FILE " \n"; print FILE " \n"; print FILE " \n"; print FILE " \n"; print FILE " "; print FILE " \n"; } print FILE "
MaintainerPackageScoreL10n bugsComment
".$packages->{$pkg}->{maintainer}."$pkg".int ($packages->{$pkg}->{score})."\n"; if (defined @{$packages->{$pkg}->{debconf}}) { print FILE " po-debconf bugs:\n"; print FILE "
    \n"; foreach my $bug (@{$packages->{$pkg}->{debconf}}) { print FILE "
  • #$bug -- $bugs->{$bug}
    • \n"; } print FILE "
\n"; } if (defined @{$packages->{$pkg}->{l10n}}) { print FILE " other l10n bugs:\n"; print FILE "
    \n"; foreach my $bug (@{$packages->{$pkg}->{l10n}}) { print FILE "
  • #$bug -- $bugs->{$bug}
    • \n"; } print FILE "
\n"; } print FILE " 		".$comments->{$packages->{$pkg}->{class}}."
\n"; print FILE "
\n"; print FILE "

Generated on $generation_date

\n"; print FILE "

Comments: Debian L10N Development Team

\n"; print FILE "\n"; print FILE "\n"; close (FILE); close (DATABASE); dl10n-3.00/dl10n-html0000755000000000000000000001416311704574441011062 0ustar #!/usr/bin/perl -w use strict; use utf8; =head1 NAME dl10n-spider -- crawl translator mailing lists (and BTS) for status updates =head1 SYNOPSIS dl10n-spider [options] lang+ =head1 DESCRIPTION This script parses the debian-l10n-ElanguageE mailing list archives. It looks for emails which title follow a specific format indicating what the author intend to translate, or the current status of his work on this translation. Those informations are saved to a dl10n database which can then be used to build a l10n coordination page or any other useless statistics. =cut use Getopt::Long; #to parse the args use LWP::UserAgent; use Debian::L10n::Html; use File::Path; use POSIX qw(strftime); my $progname = $0; $progname = $1 if $progname =~ m,([^/])+$,; my $VERSION = "4.0"; # External Version Number my $BANNER = "Debian l10n infrastructure -- mailing list spider v$VERSION"; # Version Banner - text form my $cmdline_year = undef; my $cmdline_month = undef; my $cmdline_msg = undef; my $cmdline_file = undef; my %Language = ( ar => 'arabic', ca => 'catalan', cs => 'czech', de => 'german', en => 'english', es => 'spanish', fr => 'french', gl => 'galician', nl => 'dutch', # pt => 'portuguese', pt_BR => 'brazilian', ro => 'romanian', ru => 'russian', sk => 'slovak', sv => 'swedish', tr => 'turkish', all => 'all', ); =head1 Command line option parsing =over =item General options: =over =item -h, --help display short help text =item -V, --version display version and exit =back =item Begin point of the crawling: =over =item --year=YYYY =item --month=MM =item --message=msg =back if not specified, will crawl for new messages. =item Database to fill: =over =item --sdb=STATUS_FILE use STATUS_FILE as status file (instead of $STATUS_FILE) =back =back =cut # This is put into a block to avoid main namespace pollution { sub syntax_msg { my $message = shift; if (defined $message) { print "$progname: $message\n"; } else { print "$BANNER\n"; } print < \&syntax_msg, "version|V" => \&banner, # ------------------ configuration options "sdb=s" => \$cmdline_file, ); # init commandline parser Getopt::Long::config('bundling', 'no_getopt_compat', 'no_auto_abbrev'); # process commandline options GetOptions(%opthash) or syntax_msg("error parsing options"); } my $lang = $ARGV[0]; my $language = $Language{$lang}; Html::html($cmdline_file, $lang); { my $head = < Coordination of debian-l10n-$language

Debian Project

Coordination of debian-l10n-$language

This page is made to aid the coordination of translating debian related text to $language. As documented here, translators and reviewers use pseudo-urls in the subject of e-mails to the debian-l10n-$language list for coordination.

A program parses these pseudo-urls and collects the relevant data, which are then displayed below.

EOF ; my $date = strftime('%a, %d %b %Y %H:%M:%S %z', gmtime); my $tail = <

Comments: Debian L10N Development Team

Generated on $date

EOF ; opendir D, './include' or die "Cannot open .: $!"; my @files = readdir D; closedir D; mkpath ("html/include", 02775) or die "Cannot create include directory\n" unless (-d "html/include"); mkpath ("html/$Language{$lang}", 02775) or die "Cannot create $Language{$lang} directory\n" unless (-d "html/$Language{$lang}"); foreach (grep (/^$lang\./, @files)) { next unless /\.inc$/; s/\.inc$//; open I, "; close I; open I, ">html/include/$_.inc" or die "Cannot open $_.inc $_"; print I @inc; close I; open H, ">html/$Language{$lang}/$_.html" or die "Cannot open $_.html: $_"; print H $head; print H @inc; print H $tail; close H; } } =head1 LICENSE 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. =head1 COPYRIGHT (C) 2003,2004 Tim Dijkstra 2004 Nicolas Bertolissio 2004 Martin Quinson =cut 1; dl10n-3.00/dl10n-check0000755000000000000000000012616111544665464011205 0ustar #!/usr/bin/perl -w # dl10n-check -- script investigating content of debian package searching for l10n stuff # # Copyright (C) 1999-2001,2004 Martin Quinson. # Copyright (C) 2001-2004 Denis Barbier # # 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 2 of the License, or # (at your option) any later version. use strict; use File::Find; use File::Path; use Getopt::Long; my $have_Text_Iconv = 1; eval 'use Text::Iconv'; $have_Text_Iconv = 0 if $@; use Locale::Language; use Locale::Country; use Debian::L10n::Db; use Debian::L10n::Debconf; use Debian::Pkg::DebSrc; my $progname= $0; $progname= $& if $progname =~ m,[^/]+$,; $ENV{'LC_ALL'} = 'C'; # reset locale definition $SIG{'INT'} = \&interrupted; $SIG{'QUIT'} = \&interrupted; sub interrupted { $SIG{$_[0]} = 'DEFAULT'; print "$progname: Interrupted.\n"; exit -1; } ####################################### # Global Variables ####################################### my $VERSION = "3.0"; #External Version Number my $BANNER = "Debian l10n infrastructure -- package checker v$VERSION"; # Version Banner - text form my $TMP_DIR = "/tmp/dl10n"; my $DB_FILE = "./data/status"; my $MANDB_FILE = "./data/transmonitorman"; my $FROM_FILE = ""; my $DL10N_ROOT = "./"; my $PO_ROOT = "./material/po"; my $TEMPLATES_ROOT = "./material/templates"; my $MENU_ROOT ="./material/menu"; my $MAN_ROOT = "./material/man"; my $verbose = 0; my @debug; my $force = 0; # if true, rescan package even if already in db my $force_material = 0;# if true, rescan package containing material even if already in db my $remove_unused = 0;# if true, remove packages not found in Packages file my $mark_obsolete = 0;# if true, mark files as obsolete instead of removing it my $careful = 0; # if true, save the db after each package my @pkg_list; # were we put the list of packages we are required to test my @pkg_errors; # were we put the name of packages with which we had an error my @ftp_list; # were we put the list of ftp sites we are required to test my @ftp_errors; # were we put the name of packages with which we had an error #---------------------------------------------------------------------------- # Process Command Line #---------------------------------------------------------------------------- ####################################### # Subroutines called by various options # in the options hash below. These are # invoked to process the commandline # options ####################################### # Display Command Syntax # Options: -h|--help sub syntax_msg { my $msg = shift; if (defined $msg) { print STDERR "$progname: $msg\n"; } else { print STDERR "$BANNER\n"; } print "Syntax: $0 [action] [options] [--] [package|path to the dist]+ General options: -h, --help display short help text -v, --verbose verbose messages -V, --version display version and exit -d, --debug turn debug messages ON --print-version print unadorned version number and exit Behaviour options: --careful save the db file after each package proceeding -f, --force force check even if packages are up-to-date in db --force-material force check for any package containing material -u, --remove-unused remove packages not found in Packages files --mark-obsolete when extracting package data, add a .old suffix instead of deleting old files Configuration options: -F, --files-from=FILE reads dsc filenames from FILE --db=DB_FILE use DB_FILE as database file (instead of $DB_FILE) --mandb=DB_FILE use DB_FILE as database file for manpages (instead of $MANDB_FILE) --tmp=TMP_DIR use TMP_DIR as temp dir (instead of $TMP_DIR) (warning, the script do 'rm -rf' on this dir!) --po=PO_ROOT where to store the po files (instead of $PO_ROOT) --templates=DIR where to store the debconf templates files (instead of $TEMPLATES_ROOT) --menu=DIR where to store the menu files (instead of $MENU_ROOT) --man=DIR where to store the man files (instead of $MAN_ROOT) --root=ROOTDIR search the libs in ROOTDIR (instead of $DL10N_ROOT) "; if (defined $msg) { exit 1; } else { exit 0; } } # Display Version Banner # Options: -V|--version, --print-version sub banner { if ($_[0] eq 'print-version') { print STDERR "$VERSION\n"; } else { print STDERR "$BANNER\n"; } exit 0; } # Hash used to process commandline options my %opthash = ( # ------------------ general options "help|h" => \&syntax_msg, "version|V" => \&banner, "print-version" => \&banner, "mark-obsolete" => \$mark_obsolete, "verbose|v" => \$verbose, "debug|d" => \@debug, # Count the -d flags # ------------------ behaviour options "careful" => \$careful, "force|f" => \$force, "force-material" => \$force_material, "remove-unused|u" => \$remove_unused, # ------------------ configuration options "files-from=s" => \$FROM_FILE, "db=s" => \$DB_FILE, "mandb=s" => \$MANDB_FILE, "tmp=s" => \$TMP_DIR, "root=s" => \$DL10N_ROOT, "po=s" => \$PO_ROOT, "templates=s" => \$TEMPLATES_ROOT, "man=s" => \$MAN_ROOT, "menu=s" => \$MENU_ROOT ); # init commandline parser Getopt::Long::config('bundling', 'no_getopt_compat', 'no_auto_abbrev'); # process commandline options Getopt::Long::GetOptions(%opthash) or syntax_msg("error parsing options"); #----------------------------------------------------------------------------- # The main program #----------------------------------------------------------------------------- my %synonym; # developers can't spell sections and priorities... ### ### Initialization ### my @args = (); if ($FROM_FILE ne '') { if ($FROM_FILE eq '-') { @args = ; } else { open(FROM, "< $FROM_FILE") || die "Unable to read from $FROM_FILE\n"; @args = ; close(FROM); } } push (@args, @ARGV) or syntax_msg("Nothing to do !"); push (@INC, $DL10N_ROOT); init_synonym(); my $data = Debian::L10n::Db->new(); $data->read($DB_FILE); my $date = $data->get_date(); my $mandata = Debian::L10n::Db->new(); $mandata->read($MANDB_FILE); # read args to search package files foreach my $arg (@args) { chomp $arg; if (-f $arg) { $arg =~ /\.dsc$/ || die "bad package file name $arg (not a .dsc file)"; push @pkg_list, $arg; } elsif (-d _) { # dir ? let's do a `find -name "*.dsc"` on it! open (LIST,"find $arg -name \"*.dsc\" -type f|") || die "Can't run find: $!"; while () { push @pkg_list, $_; } close LIST; } else { die "bad argument $arg (neither a .dsc file nor a directory nor a ftp path)"; } } # # main loop # my $dsc; # the path to the dsc file my $pkg; # the package name my $ver; # the package version my $maint; # maintainer's name my $deb; # instance of Debian::Pkg::DebSrc my @errors_pkg; # packages for which we had a problem if ($remove_unused) { foreach $pkg ($data->list_packages()) { $data->maintainer($pkg, ""); } } PKG: while ($dsc = shift @pkg_list) { ### ### read the name and the version ### $pkg = $ver = $maint = ""; unless (open (DESC, $dsc)) { warn "Can't read file $dsc, skipped\n"; next PKG; } { local $/ = undef; $_ = ; if (m/^Source: (.*)$/m) { $pkg = $1; } if (m/^Version: (.*)$/m) { $ver = $1; } if (m/^Maintainer: (.*)$/m) { $maint = $1; } } close DESC; if ($pkg eq "") { warn "Can't read the package name from the desc file $dsc\n"; push @errors_pkg, $pkg; next PKG; } elsif ($ver eq "") { warn "Can't read the package version from the desc file $dsc\n"; push @errors_pkg, $pkg; next PKG; } ### ### if the package is already in the data, skip it ### (unless force specified) if ($data->has_package($pkg)) { # Update Maintainer: field $data->maintainer($pkg, $maint); my $newer = ($data->version($pkg) ne $ver); if ($newer) { $newer = system ("dpkg","--compare-versions", $data->version($pkg), "\>", $ver); } if ((!$force) && $newer==0 && $data->version($pkg) ne "" && !( $force_material && ($data->has_nls($pkg) || $data->has_po($pkg) || $data->has_templates($pkg) || $data->has_podebconf($pkg) || ($mandata->has_package($pkg) && $mandata->has_man($pkg))))) { print STDERR "Package $pkg $ver (skipped) because it's already in the database\n" if ($verbose); next PKG; } else { # Erase this entry (it's an older version) $data->clear_pkg($pkg); } } print STDERR "Package $pkg $ver (processing)\n" if $verbose; ### ### unpack it ### $deb = parse_tarball($dsc, $pkg, $ver, $maint); if ($deb) { check_pkg($pkg, $deb); $data->write($DB_FILE) if $careful; } } if ($remove_unused) { foreach $pkg ($data->list_packages()) { next unless (length($pkg) && $pkg =~ /\S/); if ($data->maintainer($pkg) eq "") { print STDERR "Package $pkg ".$data->version($pkg)." removed\n" if $verbose; foreach (($PO_ROOT,$TEMPLATES_ROOT,$MENU_ROOT,$MAN_ROOT)) { File::Path::rmtree($_."/".$data->pooldir($pkg)); } $data->clear_pkg($pkg); } } } $data->write($DB_FILE); # print with which packages we had problems if (@errors_pkg > 0) { print STDERR "Some errors where encountred during the check of this packages\n"; while ($pkg = shift @errors_pkg) { print STDERR " $pkg\n"; } } ############################################################################## # The subs # ############################################################################## sub store_disk_po { my $pkg = shift; my $filename = shift; my $dirname = $filename; $dirname =~ s#/+[^/]*$##; $filename =~ s#.*/##; $filename =~ s#:#\%3a#g; return $dirname.'/'.$pkg.'_'.$data->version($pkg).'_'.$filename; } sub store_disk_menu { my $pkg = shift; my $filename = shift; $filename =~ s#.*debian/##; $filename =~ s#/#_#g; $filename =~ s#:#\%3a#g; return $pkg.'_'.$data->version($pkg).'_'.$filename; } sub store_disk_templates { my $pkg = shift; my $filename = shift; $filename =~ s#/#_#g; $filename =~ s#:#\%3a#g; return $pkg.'_'.$data->version($pkg).'_'.$filename; } sub store_disk_man { my $pkg = shift; my $filename = shift; $filename =~ s#/#_#g; $filename =~ s#:#\%3a#g; return $pkg.'_'.$data->version($pkg).'_'.$filename; } sub store_temp_dir { my $pkg = shift; return $TMP_DIR.'/'.$pkg; } sub store_temp { my $pkg = shift; my $filename = shift; return store_temp_dir($pkg).'/'.$filename; } sub store_final_location { my $type = shift; if ($type eq 'po' || $type eq 'podebconf' || $type eq 'po4a') { return $PO_ROOT.'/'.$data->pooldir($pkg).'/'.store_disk_po(@_); } elsif ($type eq 'templates') { return $TEMPLATES_ROOT.'/'.$data->pooldir($pkg).'/'.store_disk_templates(@_); } elsif ($type eq 'menu') { return $MENU_ROOT.'/'.$data->pooldir($pkg).'/'.store_disk_menu(@_); } elsif ($type eq 'man') { return $MAN_ROOT.'/'.$data->pooldir($pkg).'/'.store_disk_man(@_); } } ### ### subs ### sub parse_tarball { my $path = shift; my $pkg = shift; my $patch = ''; $data->package($pkg, $pkg); $data->version($pkg, shift); $data->maintainer($pkg, shift); $data->upstream($pkg, "debian"); # Debian::Pkg::DebSrc->new() seem to have bad time when no / is in there. # A broken basename somewhere? FIXME properly $path = "./$path" unless $path =~ m|^/|; # Determine how many characters of each files are read and cached # when parsing the tar archive # # Files cannot be stored on their definitive location, # since we do not know yet the package section, this # information is read from debian/control. # So they are stored in a temporary area, and moved away # as soon as possible. # my $match = sub { my $file = shift; # Do not consider version control files return 0 if $file =~ m#(^|/)\{arch\}/#; return 0 if $file =~ m#(^|/)\.arch-ids/#; return 0 if $file =~ m#(^|/)CVS/#; return 0 if $file =~ m#(^|/).svn/#; return -1 if $file eq 'debian/control'; return -1 if $file eq 'debian/packages'; return ":".store_temp($pkg, $file) if $file eq 'debian/po/POTFILES.in'; return ":".store_temp($pkg, $file) if $file =~ m#\.pot?$#; return ":".store_temp($pkg, $file) if $file =~ m#^debian/[^/]*menu$#; return ":".store_temp($pkg, $file) if $file =~ m#^debian/(.+\/)?(.+[.-])?templates([.-].+)?$#; my $manpage = match_manpages($pkg, $file); return ":".store_temp($pkg, $file) if $manpage; return -1 if $file =~ m#^debian/[^/]*doc-base[^/]*$#; return 80 if $file =~ m#(^|/)nls/#; return 0; }; my $match_patch = sub { my $file = shift; return -1 if $file =~ m#^debian/patches/#; return -1 if &$match($file); return 0; }; my $deb = Debian::Pkg::DebSrc->new($path, parse_dft => $match, patch_parse_dft => $match_patch, maxmem => 300000000, debug => scalar @debug, patch_debug => 0, ); unless ($deb) { $data->clear_pkg($pkg); warn "Package $pkg skipped because some file could not be retrieved\n"; return undef; } $data->upstream($pkg, "other") if $deb->get_diff_name() ne ''; $data->upstream($pkg, "dbs") if $deb->file_matches("^debian/patches/"); #####[ search the section and priority]################################# # # (a LOT of packages place spaces here, or upper case, or even typos) # ##### my $section = ""; my $priority = ""; my $pooldir = "main/"; my $control = "debian/control"; unless ($deb->file_exists($control)) { # The debian/ directory may be a link, search for # debian/control elsewhere my @list = $deb->file_matches('(^|/)debian/control$'); if (@list) { $control = $list[0]; } else { $data->clear_pkg($pkg); warn("Error: can't find debian/control; skipping package $pkg.\n"); return undef; } } $_ = $deb->file_content($control); if (m/^Section: ([^\n]*)/m) { $section = $1; $section =~ s/\s//g; } if (m/^Priority: ([^\n]*)/m) { $priority = $1; $priority =~ s/\s//g; } if (defined($synonym{$section})) { $section = $synonym{$section}; if ($section =~ m#^(contrib|non-free)/#) { $pooldir = $1."/"; } } else { $data->add_errors($pkg,"'$section' is not a valid section\n"); if ($section =~ m#^(contrib|non-free)/#) { $section = $1; $pooldir = $section."/"; } else { $section = "unknown"; } } if (defined($synonym{$priority})) { $priority = $synonym{$priority}; } else { $data->add_errors($pkg,"'$priority' is not a valid priority\n"); $priority = "unknown"; } if ($pkg =~ m/^(lib.)/) { $pooldir .= $1; } elsif ($pkg =~ m/^(.)/) { $pooldir .= $1; } $data->section ($pkg, $section); $data->priority($pkg, $priority); $data->pooldir ($pkg, $pooldir."/".$pkg); return $deb; } sub check_pkg { my $pkg = shift; my $deb = shift; #####[ Check the type of organization ]################################# # # try to guess the organisation of this stuff. It could be : # - standard gnu (po dir, Makefile.in.in file and POTFILES.in in it) # - standard nls (nls dir hopefully, with all catalogs in it) # - full (dir "en" containing po files or "nls" dir or # "LC_MESSAGES" dir) # (and hopefully man pages and info pages) ##### my $type_org = ""; my $addtype = sub { my $arg = shift; if ($type_org eq "") { $type_org = $arg; } else { $type_org = "$type_org|$arg"; } }; &$addtype("nls") if $deb->file_matches("(?:^|/)nls/"); &$addtype("gnu") if $deb->file_matches("(?:^|/)po/Makefile.in.in\$") && $deb->file_matches("(?:^|/)po/POTFILES.in\$"); &$addtype("full") if $deb->file_matches("(?:^|/)en/.*\\.po\\b") && $deb->file_matches("(?:^|/)en/.*/nls/") && $deb->file_matches("(?:^|/)en/(?:.*/)?LC_MESSAGES/"); $type_org="?" if ($type_org eq ""); $data->type($pkg, $type_org); search_nls($pkg); search_po($pkg); search_menu($pkg); # Disable search_docbase at the moment, it overwrites menu files #search_docbase($pkg); search_podebconf($pkg) || search_templates($pkg); search_po4a($pkg); search_man($pkg); ### Move extracted files to their definitive location foreach (($PO_ROOT,$TEMPLATES_ROOT,$MENU_ROOT,$MAN_ROOT)) { File::Path::rmtree($_."/".$data->pooldir($pkg)) if -d $_."/".$data->pooldir($pkg); } for my $type (qw(podebconf po4a po templates man menu)) { for my $line (@{$data->$type($pkg)}) { my $file = ${$line}[0]; $file = ${$line}[3] if $type eq 'man'; my $old = store_temp($pkg, $file); my $new = store_final_location($type, $pkg, $file); if ($type eq 'podebconf' && $file !~ m/\.pot?$/) { $new = store_final_location('templates', $pkg, $file); } my $dir = $new; $dir =~ s,/[^/]*$,,; File::Path::mkpath($dir, 0, 0755) unless -d $dir; if (system("gzip -9f -c \"$old\" > \"$new.gz\"")) { unlink "$new.gz"; warn "Cannot run: gzip -9f -c \"$old\" > \"$new.gz\": $!\n"; } } } File::Path::rmtree(store_temp_dir($pkg)); } sub match_manpages { my $pkg = shift; my $file = shift; return unless $mandata->has_package($pkg) && $mandata->has_man($pkg); foreach my $line (@{$mandata->man($pkg)}) { my ($man, $lang, $link) = @{$line}; return $link if defined($link) && $file eq $link; } return 0; } #----[ search_nls ]------------------------------------------------------------- sub search_nls { my $pkg = shift; my $line; $data->nls($pkg, ()); foreach ($deb->file_matches("(?:^|/)nls/")) { $line = $deb->file_content($_, 80); $data->add_nls($pkg, $_) if $line =~ m/^\$set[\s\d]+#/s; } } #----[ search_po ]-------------------------------------------------------------- sub search_po { my $pkg = shift; my @pofiles = $deb->file_matches("\\.pot?\$"); foreach my $file (@pofiles) { next if $file =~ m,^debian/po/,; next if $file =~ m,(?:^|/)(doc|man|po4a)/(?:.*/)?po/,; next if $file =~ m,(?:^|/)po/pod/,; # po4a next if $file =~ m,messages.po$,; next if $file =~ m,(^|/)tests/,; # Those are tests. next if ( ( ($pkg eq "po4a") or ($pkg eq "bioperl")) and ($file =~ m/^t\//)); next if ( ($pkg eq "po4a") and ($file =~ m/^intl\//)); process_po_file($pkg, $file, 'po'); } print STDERR "MEM: ".$deb->get_max_memory()."\n" if $verbose; } sub convert_to_unicode ($$) { my $encoding = shift; my $string = shift; my $qstring = $string; # If conversion fails, non-ASCII characters are replaced by ? $qstring =~ s/[\x80-\xff]/?/g; return $qstring unless $have_Text_Iconv; my $converter; eval '$converter = Text::Iconv->new($encoding, "UTF-32BE")'; return $qstring if $@; my $result = $converter->convert($string) or return $qstring; my $ret = ""; while($result =~ m/(.)(.)(.)(.)/sg) { my $ucs = ord($1)*0x1000000 + ord($2)*0x10000 + ord($3)*0x100 + ord($4); $ret .= ($ucs > 0x7e ? "&#$ucs;" : chr($ucs)); } return $ret; } sub process_po_file { my $pkg = shift; my $file = shift; my $type = shift; $type = 'add_'.$type; my $filename; #the po file name to be archived my $lang=""; # the identified code language my $bad_lang=""; #this could be a language, but this is not a valid language my $this_stat = ""; #stats for this file my $err_msg =""; # err msg of the statistic external command (ie, msgfmt or debconf-stats) my $regexp_for_lang_code = '(([a-zA-Z]{2,3})([-_][a-zA-Z]{2})?(@[^./]*)?)(\.[^./]+)?'; $filename = store_temp($pkg, $file); my $lasttrans = ""; my $langteam = ""; $this_stat = ""; $lang = ""; $lang = '_' if $file=~ m/\.pot$/; if ($lang eq "" && $file=~ m,(?:_|\b)$regexp_for_lang_code\.po$,o) { $bad_lang =$1; if (is_lang($bad_lang)) { $lang = $bad_lang; $bad_lang = ""; } } # The next rule is for kde-i18n and other such packages if ($lang eq "" && $file =~ m,(?:^|/)$regexp_for_lang_code/(messages|LC_MESSAGES)/,) { $bad_lang = $1; if (is_lang($bad_lang)) { $lang = $bad_lang; $bad_lang = ""; } } if ($lang eq "" && $file =~ m,po/$regexp_for_lang_code/.*\.po,) { $bad_lang = $1; if (is_lang($bad_lang)) { $lang = $bad_lang; $bad_lang = ""; } } if ($lang ne "") { # stats the file ($this_stat, $err_msg) = read_stats("msgfmt --statistics -o /dev/null $filename 2>&1 1>/dev/null"); if ($err_msg ne '') { $err_msg =~ s,\Q$filename\E,$file,g; $data->add_errors($pkg, "gettext: ".$err_msg); } } else { # no valid lang found if ($bad_lang eq "") { $data->add_errors($pkg, "gettext: $file: can't guess language"); } else { $data->add_errors($pkg, "gettext: $file: $bad_lang not a language code"); } } # Add this file to the data my $header = ''; if ($lang ne "_") { local $/ = "\n\n"; open(PO, "< $filename"); while () { if (m/^msgid/m) { $header = $_; last; } } close(PO); } if ($header ne '') { if ($header =~ m/^"Last-Translator:\s*(.*)\\n"\r?$/m) { $lasttrans = $1 || ''; $lasttrans =~ s/!//g; $lasttrans = '' if $lasttrans =~ m/EMAIL\@ADDRESS/; } if ($header =~ m/^"Language-Team:\s*(.*)\\n"\r?$/m) { $langteam = $1 || ''; $langteam =~ s/!//g; $langteam = '' if $langteam =~ m//; } if ($header =~ m/^"Content-Type:.*charset=(.*)\\n"\r?$/m) { my $encoding = $1; $lasttrans = convert_to_unicode($encoding, $lasttrans); $langteam = convert_to_unicode($encoding, $langteam); } } # Add this file to the data $data->$type($pkg, $file, normalize_lang($lang), $this_stat, store_disk_po($pkg, $file), $lasttrans, $langteam); } #----[ search_menu ]----------------------------------------------------------- sub search_menu { my $pkg = shift; my $filename; my @menufiles = $deb->file_matches("^debian/[^/]*menu\$"); foreach my $file (@menufiles) { # Add this file to the data $data->add_menu($pkg, $file, store_disk_menu($pkg, $file)); } } #----[ search_docbase ]--------------------------------------------------------- sub search_docbase { my $pkg = shift; my ($dirname, $filename); my @docbasefiles = $deb->file_matches("^debian/[^/]*doc-base[^/]*\$"); foreach my $file (@docbasefiles) { $_ = $deb->file_content($file); next unless m/^Document:\s*(\S*)\s*$/m; $filename = 'doc-base-' . $1; $dirname = $file; $dirname =~ s#/+[^/]*$##; $filename = $dirname . '/' . $filename; $filename =~ s,^.*debian/,,; $filename =~ s/:/\%3a/g; $filename =~ s,/,_,g; File::Path::mkpath($MENU_ROOT."/".$data->pooldir($pkg), 0, 0755); unless (open (DOCBASE, "> $MENU_ROOT/".$data->pooldir($pkg)."/$filename")) { warn "Unable to write to $MENU_ROOT/".$data->pooldir($pkg)."/$filename\n"; next; } print DOCBASE; close DOCBASE; $data->add_menu($pkg, $file, $filename); } } #----[ search_man ]------------------------------------------------------------ sub search_man { my $pkg = shift; return unless $mandata->has_package($pkg) && $mandata->has_man($pkg); foreach my $line (@{$mandata->man($pkg)}) { my ($man, $lang, $link) = @{$line}; next unless defined($link); my $manpage = match_manpages($pkg, $link); $data->add_man($pkg, $man, $lang, store_disk_man($pkg, $manpage), $link); } } #----[ search_templates ]------------------------------------------------------ sub search_templates { my $pkg = shift; my ($filename, $tmpl, %tmpl_stats, $this_stat, @list, @list2); my @debconffiles = $deb->file_matches("^debian/([^/]+\\.)?templates([.-]in)?\$"); # print "Got ".(scalar @debconffiles)." files: "; # map { print $_." " } @debconffiles; # print "\n"; $tmpl = Debian::L10n::Debconf->new(); foreach my $file (@debconffiles) { # All translations in a single file next if $deb->file_matches("^".$file."\\...(_..)?\$"); next if $file =~ m,(^|/)tests/,; # Add this file to data $filename = store_disk_templates($pkg, $file); my $tempfile = store_temp($pkg, $file); # Trap warnings from Debian::L10n::Debconf and reword them { local $SIG{__WARN__} = sub { my $msg = $_[0]; $msg =~ s,^\Q$tempfile\E,debconf: $file,; $data->add_errors($pkg, $msg); }; eval { $tmpl->read_compact($tempfile) }; } %tmpl_stats = $tmpl->stats(); # Add information about English template $data->add_templates($pkg, $file, '_', $tmpl->count().'t0f0u', $filename); foreach (keys %tmpl_stats) { $this_stat = $tmpl_stats{$_}->[0].'t'.$tmpl_stats{$_}->[1].'f'.$tmpl_stats{$_}->[2].'u'; $data->add_templates($pkg, $file, normalize_lang($_), $this_stat, $filename); } { # Reports an error if debian/po/templates.pot # or debian/po/POTFILES.in files are missing # when templates file seem to be in po-debconf # format. local $/ = undef; open(TEMPLATE, "< $tempfile"); $_ =