CDDB-1.222/000755 000765 000024 00000000000 12203077571 012332 5ustar00trocstaff000000 000000 CDDB-1.222/CHANGES000644 000765 000024 00000003604 12203077571 013330 0ustar00trocstaff000000 000000 ================================================== Changes from 2012-08-15 00:00:00 +0000 to present. ================================================== ------------------------------------------ version 1.222 at 2013-08-15 07:12:54 +0000 ------------------------------------------ Change: 3161b01391d7ec55d7fd8f06b6de9ceb31126416 Author: Rocco Caputo Date : 2013-08-15 03:03:53 +0000 Automate more of dist.ini. ------------------------------------------ version 1.221 at 2013-08-04 06:13:24 +0000 ------------------------------------------ Change: 4e0b8cc01214485a5d4f40b7318f2646f84c5ccb Author: Rocco Caputo Date : 2013-08-04 02:13:24 +0000 Add .gitignore and MANIFEST.SKIP to ignore build artifacts. Releases will fail because the release built artifacts look like untracked files. Ignore them in .gitignore. Also ignore temporary files in MANIFEST.SKIP. Change: c5467dc4260c3ceb57e8253957c1449d3d00617a Author: Rocco Caputo Date : 2013-08-04 02:01:30 +0000 [rt.cpan.org 65060] Don't destroy the server list when connections fail. Connections may fail for transient reasons. It's better to assume the servers will come back eventually and take the performance hit on reconnect than to exhaust the list and never succeed again. If this fix helps you, thank Timo Santi for reporting the bug. Change: b9835824080c25817a37bcbf6d1c3bb4ab5d51f7 Author: Rocco Caputo Date : 2013-08-04 01:43:39 +0000 Switch to Dist::Zilla. Change: 15ec95acbfed79a4f4e341e150af25964fc776a3 Author: Rocco Caputo Date : 2010-03-08 01:29:07 +0000 Fix the repository URLs and copyright date in the docs. ================================================ Plus 4 releases after 2012-08-15 00:00:00 +0000. ================================================ CDDB-1.222/dist.ini000644 000765 000024 00000001415 12203077571 013777 0ustar00trocstaff000000 000000 name = CDDB author = Rocco Caputo copyright_holder = Rocco Caputo license = Perl_5 [AutoMetaResources] bugtracker.rt = 1 license = http://dev.perl.org/licenses/ repository.github = user:rcaputo;lcdist:cddb-perl [AutoPrereqs] [CheckPrereqsIndexed] [Prereqs::MatchInstalled::All] exclude = bytes exclude = constant exclude = lib exclude = perl exclude = strict exclude = vars exclude = warnings [Homepage] [ReadmeFromPod] [ReadmeMarkdownFromPod] [ReportVersions] [Repository] git_remote = gh [Git::Check] [Git::NextVersion] first_version = 1.221 version_regexp = ^v(\d+\.\d+)$ [ChangelogFromGit] tag_regexp = v(\d+[_.]\d+) [Git::Tag] tag_format = v%v tag_message = Release %v. [@Classic] [MetaJSON] CDDB-1.222/eg/000755 000765 000024 00000000000 12203077571 012725 5ustar00trocstaff000000 000000 CDDB-1.222/HISTORY000644 000765 000024 00000014115 12203077571 013420 0ustar00trocstaff000000 000000 $Id$ Changes after 1.16 are listed in the CHANGES file. *** 1.16 2005-09-17 Applied Moshe Kaminsky's patch to support utf-8 submissions. *** 1.15 2004-09-08 Tilman Sauerbeck updated the ID calculations to work with FreeDB's reference CD. Previously they were slightly off, but the protocol's fuzzy matching had been compensating. *** 1.14 2004-09-01 Applied Steve James' patch to improve dead connection detection. It prevents harmless yet annoying warnings. Applied Ronan Waide's patch to expose the XMCD file parsing code. The new method is parse_xmcd_file(). *** 1.12 2004-02-12 Applied Duncan Martin's patch for submitting year and long genre data. Performed some long overdue tweaking in the tests. The CD databases are constantly moving targets, and the freedb servers recently prohibited multiple queries for the same disc in the same connection. Upshot: The tests pass once again. Cleaned up the code a little in CDDB.pm and cddb.t. *** 1.11 2003-08-13 Version 1.10 was an empty distribution, because I mistakenly deleted the MANIFEST. This fixes the last release. *** 1.10 2003-08-13 Applied Albrecht Kleine's patch to make the xmcd parser more robust. Some software and/or devices submit records that are slightly off and broke CDDB.pm in the past. *** 1.09 2003-07-31 Added Christopher Hartmann's patches to the 1.08 changes, and set the 1.08 release date. Whoops! I was in a hurry to release that one. Colin Meyer pointed out some confusing language in the get_discs() documentation. Rocco fixed it. Added Ron Grabowski's get_discs_by_query() function. This fetches discs by a query string, rather than a table of contents. Added Michael Jung's parse_cdinfo() function. This parses the output of cdinfo into a table of contents suitable for calculate_id(). Michael Jung suggested that the module display a diagnostic if all the known CDDB protocol servers are unavailable. That seemed reasonable, so CDDB.pm warns if it can't contact a server. *** 1.08 2002.01.19 Applied henke's patch to support CDDB protocol level 5, if available. Applied Yannick Le Saint's patch to try localhost:8880. Made localhost the first server to try. Applied Yannick Le Saint's patch to add a missing =back to the POD. Jonathan Stowe and Yannick Le Saint supplied patches to avoid dying if no cddbp servers are available. Rocco applied something different to achieve the same goal. Applied Christopher Hartmann's patch to let programmers specif new cddbp versions. Applied Christopher Hartmann's patch to return the entire unparsed xmcd record. *** 1.07 2001.11.18 Fixed t/cddb.t to not care *what* it gets as long as it gets something. *** 1.06 2001.07.17 Added get_mail_host() and get_mail_address() methods to query what the module thinks your SMTP host and e-mail address are. Their purpose is to fetch values for confirmation or correction before submitting disc records. FreeDB servers sometimes emit error 530 on connection instead of the regular 201 banner. The CDDB module wouldn't handle this very well; now it closes the connection and tries again automatically. Disc submissions had hardcoded revisions of 1. They should be 0 for new discs and one more than the last for updates. Fixed submit_disc() to honor its documented Revision parameter. Fixed submit_disc() to transmit e-mail submissions using ISO-8859-1 (Latin 1) and quoted-printable. What's this mean? Basically: Western European characters won't get mangled by intermediate mail servers. Drew Taylor discovered that the tests fail on MSWin32 because getpwuid() isn't implemented on that platform. Worked around its absence on MSWin32 systems, and documented this bit of CDDB more carefully. *** 1.05 2001.05.03 Christoph Lorenz pointed out that the module is noisy even when debugging is turned off. I made sure that all the carp calls are behind debuging checks. *** 1.04 2001.03.24 Switched from cddb.com servers to freedb.org servers. cddb.com has been denying CDDB.pm users. Made some of the tests even fuzzier. *** 1.03 2000.03.27 Perl no longer likes defined(@array); tweak, tweak, tweak. CDDB returns a different code for "Achtung, Baby"; tweak, tweak, tweak. Updated the default hosts with the most recent CDDB protocol sites list; tweak, tweak, tweak. *** 1.02 1999.08.13 Once again, someone has changed the compact disc record that CDDB tests against. This broke tests 16 (disc title) and 26 (track titles). Once again I have made the tests fuzzier, so they will pass again. This version's CDDB.pm is identical to 1.01's, except for the version number. *** 1.01 1999.07.16 Just as I was getting ready to celebrate a bug-free CDDB module, along comes some Macintosh freak with spaces in his login ID (Hi, Schwern!). So now the module squashes spaces and replaces them with underscores. And if that isn't enough, CDDB's constructor now accepts an optional Login parameter. *** 1.00 1999.07.16 Whenever someone updates a CDDB record that cddb.t tests against, it breaks the test. It's a fairly harmless problem, but it does cause CDDB not to pass its tests. I'm fed up with it after a few iterations, so I changed the hard "retrieved track offset != stored one" tests with a more lenient "retrieved track offset within 5% of stored one". While I'm at it, make the title tests approximate by normalizing whitespace and only comparing consonants. Sort of an approximate metaphone match. Still to do: The genres and track-lengths tests haven't been made fuzzy in this version. *** 0.07-beta 1998.11.27 Added a list of CDDB servers inside CDDB.pm. Added code to cycle through the servers upon receipt of "417 Database access limit reached" or connection errors. Made t/cddb.t a little lamer for the sake of passing the fuzzy matches tests. Added information about the CDDB submission test to README. Chris Nandor suggested a get_discs_after_calculating_id() macro function. Added it under the name get_discs_by_toc(). Whoops! CDDB::message() was missing, but it was never called during testing. Until today. Added CDDB::message(). *** 0.06-beta Fixed newlines in submit_disc so they meet Net::Cmd expectations Added the HISTORY file to track changes. -EOF- CDDB-1.222/lib/000755 000765 000024 00000000000 12203077571 013100 5ustar00trocstaff000000 000000 CDDB-1.222/LICENSE000644 000765 000024 00000043744 12203077571 013353 0ustar00trocstaff000000 000000 This software is copyright (c) 2013 by Rocco Caputo . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2013 by Rocco Caputo . This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy 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 1, 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., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2013 by Rocco Caputo . This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End CDDB-1.222/Makefile.PL000644 000765 000024 00000003304 12203077571 014304 0ustar00trocstaff000000 000000 use strict; use warnings; use 5.001; use ExtUtils::MakeMaker 6.30; my %WriteMakefileArgs = ( "ABSTRACT" => "a high-level interface to cddb protocol servers (freedb and CDDB)", "AUTHOR" => "Rocco Caputo ", "BUILD_REQUIRES" => {}, "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => "6.30" }, "DISTNAME" => "CDDB", "EXE_FILES" => [], "LICENSE" => "perl", "NAME" => "CDDB", "PREREQ_PM" => { "Carp" => "1.26", "Encode" => "2.51", "HTTP::Request" => "6.00", "IO::Socket" => "1.31", "LWP" => "6.05", "MIME::QuotedPrint" => "3.13", "Mail::Header" => "2.04", "Mail::Internet" => "2.04", "Sys::Hostname" => "1.11", "strict" => 0, "vars" => 0 }, "TEST_REQUIRES" => { "Scalar::Util" => "1.29", "Test::More" => "0.98", "warnings" => 0 }, "VERSION" => "1.222", "test" => { "TESTS" => "t/*.t" } ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { my $tr = delete $WriteMakefileArgs{TEST_REQUIRES}; my $br = $WriteMakefileArgs{BUILD_REQUIRES}; for my $mod ( keys %$tr ) { if ( exists $br->{$mod} ) { $br->{$mod} = $tr->{$mod} if $tr->{$mod} > $br->{$mod}; } else { $br->{$mod} = $tr->{$mod}; } } } unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) { my $br = delete $WriteMakefileArgs{BUILD_REQUIRES}; my $pp = $WriteMakefileArgs{PREREQ_PM}; for my $mod ( keys %$br ) { if ( exists $pp->{$mod} ) { $pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod}; } else { $pp->{$mod} = $br->{$mod}; } } } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); CDDB-1.222/MANIFEST000644 000765 000024 00000000333 12203077571 013462 0ustar00trocstaff000000 000000 CHANGES HISTORY LICENSE MANIFEST MANIFEST.SKIP META.json META.yml Makefile.PL README README.mkdn dist.ini eg/osx-lookup.pl lib/CDDB.pm t/000-report-versions.t t/01_cddb.t t/release-pod-coverage.t t/release-pod-syntax.t CDDB-1.222/MANIFEST.SKIP000600 000765 000024 00000000326 12203077571 014221 0ustar00trocstaff000000 000000 CVS \.\# \.bak$ \.cvsignore \.git \.gz$ \.orig$ \.patch$ \.ppd$ \.rej$ \.rej$ \.svn \.swo$ \.swp$ ^Makefile$ ^Makefile\.old$ ^\. ^_Inline ^_build ^blib/ ^comptest ^cover_db ^coverage\.report$ ^pm_to_blib$ ~$ devel CDDB-1.222/META.json000644 000765 000024 00000003623 12203077571 013757 0ustar00trocstaff000000 000000 { "abstract" : "a high-level interface to cddb protocol servers (freedb and CDDB)", "author" : [ "Rocco Caputo " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 4.300035, CPAN::Meta::Converter version 2.132140", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "CDDB", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.30" } }, "develop" : { "requires" : { "Pod::Coverage::TrustPod" : "0", "Test::Pod" : "1.41", "Test::Pod::Coverage" : "1.08" } }, "runtime" : { "requires" : { "Carp" : "1.26", "Encode" : "2.51", "HTTP::Request" : "6.00", "IO::Socket" : "1.31", "LWP" : "6.05", "MIME::QuotedPrint" : "3.13", "Mail::Header" : "2.04", "Mail::Internet" : "2.04", "Sys::Hostname" : "1.11", "perl" : "5.001", "strict" : "0", "vars" : "0" } }, "test" : { "requires" : { "Scalar::Util" : "1.29", "Test::More" : "0.98", "perl" : "5.004", "warnings" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-CDDB@rt.cpan.org", "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=CDDB" }, "homepage" : "http://search.cpan.org/dist/CDDB/", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "git://github.com/rcaputo/cddb-perl.git", "web" : "https://github.com/rcaputo/cddb-perl" } }, "version" : "1.222" } CDDB-1.222/META.yml000644 000765 000024 00000001643 12203077571 013607 0ustar00trocstaff000000 000000 --- abstract: 'a high-level interface to cddb protocol servers (freedb and CDDB)' author: - 'Rocco Caputo ' build_requires: Scalar::Util: 1.29 Test::More: 0.98 perl: 5.004 warnings: 0 configure_requires: ExtUtils::MakeMaker: 6.30 dynamic_config: 0 generated_by: 'Dist::Zilla version 4.300035, CPAN::Meta::Converter version 2.132140' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: CDDB requires: Carp: 1.26 Encode: 2.51 HTTP::Request: 6.00 IO::Socket: 1.31 LWP: 6.05 MIME::QuotedPrint: 3.13 Mail::Header: 2.04 Mail::Internet: 2.04 Sys::Hostname: 1.11 perl: 5.001 strict: 0 vars: 0 resources: bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=CDDB homepage: http://search.cpan.org/dist/CDDB/ license: http://dev.perl.org/licenses/ repository: git://github.com/rcaputo/cddb-perl.git version: 1.222 CDDB-1.222/README000644 000765 000024 00000056345 12203077571 013227 0ustar00trocstaff000000 000000 NAME CDDB.pm - a high-level interface to cddb protocol servers (freedb and CDDB) VERSION version 1.222 SYNOPSIS use CDDB; ### Connect to the cddbp server. my $cddbp = new CDDB( Host => 'freedb.freedb.org', # default Port => 8880, # default Login => $login_id, # defaults to %ENV's ) or die $!; ### Retrieve known genres. my @genres = $cddbp->get_genres(); ### Calculate cddbp ID based on MSF info. my @toc = ( '1 0 2 37', # track, CD-i MSF (space-delimited) '999 1 38 17', # lead-out track MSF '1000 0 0 Error!', # error track (don't include if ok) ); my ( $cddbp_id, # used for further cddbp queries $track_numbers, # padded with 0's (for convenience) $track_lengths, # length of each track, in MM:SS format $track_offsets, # absolute offsets (used for further cddbp queries) $total_seconds # total play time, in seconds (for cddbp queries) ) = $cddbp->calculate_id(@toc); ### Query discs based on cddbp ID and other information. my @discs = $cddbp->get_discs($cddbp_id, $track_offsets, $total_seconds); foreach my $disc (@discs) { my ($genre, $cddbp_id, $title) = @$disc; } ### Query disc details (usually done with get_discs() information). my $disc_info = $cddbp->get_disc_details($genre, $cddbp_id); my $disc_time = $disc_info->{'disc length'}; my $disc_id = $disc_info->{discid}; my $disc_title = $disc_info->{dtitle}; my @track_offsets = @{$disc_info->{offsets}}; my @track_seconds = @{$disc_info->{seconds}}; my @track_titles = @{$disc_info->{ttitles}}; # other information may be returned... explore! ### Submit a disc via e-mail. (Requires MailTools) die "can't submit a disc (no mail modules; see README)" unless $cddbp->can_submit_disc(); # These are useful for prompting the user to fix defaults: print "I will send mail through: ", $cddbp->get_mail_host(), "\n"; print "I assume your e-mail address is: ", $cddbp->get_mail_address(), "\n"; # Actually submit a disc record. $cddbp->submit_disc( Genre => 'classical', Id => 'b811a20c', Artist => 'Various', DiscTitle => 'Cartoon Classics', Offsets => $disc_info->{offsets}, # array reference TrackTitles => $disc_info->{ttitles}, # array reference From => 'login@host.domain.etc', # will try to determine ); DESCRIPTION CDDB protocol (cddbp) servers provide compact disc information for programs that need it. This allows such programs to display disc and track titles automatically, and it provides extended information like liner notes and lyrics. This module provides a high-level Perl interface to cddbp servers. With it, a Perl program can identify and possibly gather details about a CD based on its "table of contents" (the disc's track times and offsets). Disc details have been useful for generating CD catalogs, naming mp3 files, printing CD liners, or even just playing discs in an automated jukebox. Despite the module's name, it connects to FreeDB servers by default. This began at version 1.04, when cddb.com changed its licensing model to support end-user applications, not third-party libraries. Connections to cddb.com may still work, and patches are welcome to maintain that functionality, but it's no longer officially supported. PUBLIC METHODS new PARAMETERS Creates a high-level interface to a cddbp server, returning a handle to it. The handle is not a filehandle. It is an object. The new() constructor provides defaults for just about everything, but everything is overrideable if the defaults aren't appropriate. The interface will not actually connect to a cddbp server until it's used, and a single cddbp interface may actually make several connections (to possibly several servers) over the course of its use. The new() constructor accepts several parameters, all of which have reasonable defaults. Host and Port describe the cddbp server to connect to. These default to 'freedb.freedb.org' and 8880, which is a multiplexor for all the other freedb servers. Utf8 is a boolean flag. If true, utf-8 will be used when submitting CD info, and for interpreting the data reveived. This requires the Encode module (and probably perl version at least 5.8.0). The default is true if the Encode module can be loaded. Otherwise, it will be false, meaning we fall back to ASCII. Protocol_Version sets the cddbp version to use. CDDB.pm will not connect to servers that don't support the version specified here. The requested protocol version defaults to 1 if Utf8 is off, and to 6 if it is on. Login is the login ID you want to advertise to the cddbp server. It defaults to the login ID your computer assigns you, if that can be determined. The default login ID is determined by the presence of a LOGNAME or USER environment variable, or by the getpwuid() function. On Windows systems, it defaults to "win32usr" if no default method can be found and no Login parameter is set. Submit_Address is the e-mail address where new disc submissions go. This defaults to 'freedb-submit@freedb.org'. Note, that testing submissions should be done via "test-submit@freedb.org". Client_Name and Client_Version describe the client software used to connect to the cddbp server. They default to 'CDDB.pm' and CDDB.pm's version number. If developers change this, please consult freedb's web site for a list of client names already in use. Debug enables verbose operational information on STDERR when set to true. It's normally not needed, but it can help explain why a program is failing. If someone finds a reproduceable bug, the Debug output and a test program would be a big help towards having it fixed. In case of submission, if this flag is on, a copy of the submission e-mail will be sent to the *From* address. get_genres Takes no parameters. Returns a list of genres known by the cddbp server, or undef if there is a problem retrieving them. calculate_id TOC The cddb protocol defines an ID as a hash of track lengths and the number of tracks, with an added checksum. The most basic information required to calculate this is the CD table of contents (the CD-i track offsets, in "MSF" [Minutes, Seconds, Frames] format). Note however that there is no standard way to acquire this information from a CD-ROM device. Therefore this module does not try to read the TOC itself. Instead, developers must combine CDDB.pm with a CD library which works with their system. The AudioCD suite of modules is recommended: it has system specific code for MacOS, Linux and FreeBSD. CDDB.pm's author has used external programs like dagrab to fetch the offsets. Actual CDs aren't always necessary: the author has heard of people generating TOC information from mp3 file lengths. That said, see parse_cdinfo() for a routine to parse "cdinfo" output into a table of contents list suitable for calculate_id(). calculate_id() accepts TOC information as a list of strings. Each string contains four fields, separated by whitespace: offset 0: the track number Track numbers start with 1 and run sequentially through the number of tracks on a disc. Note: data tracks count on hybrid audio/data CDs. CDDB.pm understands two special track numbers. Track 999 holds the lead-out information, which is required by the cddb protocol. Track 1000 holds information about errors which have occurred while physically reading the disc. offset 1: the track start time, minutes field Tracks are often addressed on audio CDs using "MSF" offsets. This stands for Minutes, Seconds, and Frames (fractions of a second). The combination pinpoints the exact disc frame where a song starts. Field 1 contains the M part of MSF. It is ignored for error tracks, but it still must contain a number. Zero is suggested. offset 2: the track start time, seconds field This field contains the S part of MSF. It is ignored for error tracks, but it still must contain a number. Zero is suggested. offset 3: the track start time, frames field This field contains the F part of MSF. For error tracks, it contains a description of the error. Example track file. Note: the comments should not appear in the file. 1 0 2 37 # track 1 starts at 00:02 and 37 frames 2 1 38 17 # track 2 starts at 01:38 and 17 frames 3 11 57 30 # track 3 starts at 11:57 and 30 frames ... 999 75 16 5 # leadout starts at 75:16 and 5 frames Track 1000 should not be present if everything is okay: 1000 0 0 Error reading TOC: no disc in drive In scalar context, calculate_id() returns just the cddbp ID. In a list context, it returns an array containing the following values: ( $cddbp_id, $track_numbers, $track_lengths, $track_offsets, $total_seconds ) = $cddbp->calculate_id(@toc); print( "cddbp ID = $cddbp_id\n", # b811a20c "track numbers = @$track_numbers\n", # 001 002 003 ... "track lengths = @$track_lengths\n", # 01:36 10:19 04:29 ... "track offsets = @$track_offsets\n", # 187 7367 53805 ... "total seconds = $total_seconds\n", # 4514 ); CDDBP_ID The 0th returned value is the hashed cddbp ID, required for any queries or submissions involving this disc. TRACK_NUMBERS The 1st returned value is a reference to a list of track numbers, one for each track (excluding the lead-out), padded to three characters with leading zeroes. These values are provided for convenience, but they are not required by cddbp servers. TRACK_LENGTHS The 2nd returned value is a reference to a list of track lengths, one for each track (excluding the lead-out), in HH:MM format. These values are returned as a convenience. They are not required by cddbp servers. TRACK_OFFSETS The 3rd returned value is a reference to a list of absolute track offsets, in frames. They are calculated from the MSF values, and they are required by get_discs() and submit_disc(). TOTAL_SECONDS The 4th and final value is the total playing time for the CD, in seconds. The get_discs() function needs it. get_discs CDDBP_ID, TRACK_OFFSETS, TOTAL_SECONDS get_discs() asks the cddbp server for a summary of all the CDs matching a given cddbp ID, track offsets, and total playing time. These values can be retrieved from calculade_id(). my @id_info = $cddbp->calculate_id(@toc); my $cddbp_id = $id_info->[0]; my $track_offsets = $id_info->[3]; my $total_seconds = $id_info->[4]; get_discs() returns an array of matching discs, each of which is represented by an array reference. It returns an empty array if the query succeeded but did not match, and it returns undef on error. my @discs = $cddbp->get_discs( $cddbp_id, $track_offsets, $total_seconds ); foreach my $disc (@discs) { my ($disc_genre, $disc_id, $disc_title) = @$disc; print( "disc id = $disc_id\n", "disc genre = $disc_genre\n", "disc title = $disc_title\n", ); } DISC_GENRE is the genre this disc falls into, as determined by whoever submitted or last edited the disc. The genre is required when requesting a disc's details. See get_genres() for how to retrieve a list of cddbp genres. CDDBP_ID is the cddbp ID of this disc. Cddbp servers perform fuzzy matches, returning near misses as well as direct hits on a cddbp ID, so knowing the exact ID for a disc is important when submitting changes or requesting a particular near-miss' details. DISC_TITLE is the disc's title, which may help a human to pick the correct disc out of several close mathches. get_discs_by_toc TOC This function acts as a macro, combining calculate_id() and get_discs() calls into one function. It takes the same parameters as calculate_id(), and it returns the same information as get_discs(). get_discs_by_query QUERY_STRING Fetch discs by a pre-built cddbp query string. Some disc querying programs report this string, and get_discs_by_query() is a convenient way to use that. Cddb protocol query strings look like: cddb query $cddbp_id $track_count @offsets $total_seconds get_disc_details DISC_GENRE, CDDBP_ID This function fetches a disc's detailed information from a cddbp server. It takes two parameters: the DISC_GENRE and the CDDP_ID. These parameters usually come from a call to get_discs(). The disc's details are returned in a reference to a fairly complex hash. It includes information normally stored in comments. The most common entries in this hash include: $disc_details = get_disc_details( $disc_genre, $cddbp_id ); $disc_details->{"disc length"} The disc length is commonly stored in the form "### seconds", where ### is the disc's total playing time in seconds. It may hold other time formats. $disc_details->{discid} This is a rehash (get it?) of the cddbp ID. It should match the CDDBP_ID given to get_disc_details(). $disc_details->{dtitle} This is the disc's title. I do not know whether it will match the one returned by get_discs(). $disc_details->{offsets} This is a reference to a list of absolute disc track offsets, similar to the TRACK_OFFSETS returned by calculate_id(). $disc_details->{seconds} This is a reference to a list of track length, in seconds. $disc_details->{ttitles} This is a reference to a list of track titles. These are the droids you are looking for. $disc_details->{"processed by"} This is a comment field identifying the name and version of the cddbp server which accepted and entered the disc record into the database. $disc_details->{revision} This is the disc record's version number, used as a sanity check (semaphore?) to prevent simultaneous revisions. Revisions start at 0 for new submissions and are incremented for every correction. It is the responsibility of the submitter (be it a person or a program using CDDB.pm) to provide a correct revision number. $disc_details->{"submitted via"} This is the name and version of the software that submitted this cddbp record. The main intention is to identify records that are submitted by broken software so they can be purged or corrected. $disc_details->{xmcd_record} The xmcd_record field contains a copy of the entire unprocessed cddbp response that generated all the other fields. $disc_details->{genre} This is merely a copy of DISC_GENRE, since it's otherwise not possible to determine it from the hash. parse_xmcd_file XMCD_FILE_CONTENTS, [GENRE] Parses an array ref of lines read from an XMCD file into the disc_details hash described above. If the GENRE parameter is set it will be included in disc_details. can_submit_disc Returns true or false, depending on whether CDDB.pm has enough dependent modules to submit discs. If it returns false, you are missing Mail::Internet, Mail::Header, or MIME::QuotedPrint. get_mail_address Returns what CDDB.pm thinks your e-mail address is, or what it was last set to. It was added to fetch the default e-mail address so users can see it and have an opportunity to correct it. my $mail_from = $cddb->get_mail_address(); print "New e-mail address (or blank to keep <$mail_from>): "; my $new_mail_from = ; $new_mail_from =~ s/^\s+//; $new_mail_from =~ s/\s+$//; $new_mail_from =~ s/\s+/ /g; $mail_from = $new_mail_from if length $new_mail_from; $cddbp->submit_disc( ..., From => $mail_from, ); get_mail_host Returns what CDDB.pm thinks your SMTP host is, or what it was last set to. It was added to fetch the default e-mail transfer host so users can see it and have an opportunity to correct it. my $mail_host = $cddb->get_mail_host(); print "New e-mail host (or blank to keep <$mail_host>): "; my $new_mail_host = ; $new_mail_host =~ s/^\s+//; $new_mail_host =~ s/\s+$//; $new_mail_host =~ s/\s+/ /g; $mail_host = $new_mail_host if length $new_mail_host; $cddbp->submit_disc( ..., Host => $mail_host, ); parse_cdinfo CDINFO_FILE Generates a table of contents suitable for calculate_id() based on the output of a program called "cdinfo". CDINFO_FILE may either be a text file, or it may be the cdinfo program itself. my @toc = parse_cdinfo("cdinfo.txt"); # read cdinfo.txt my @toc = parse_cdinfo("cdinfo|"); # run cdinfo directly The table of contents can be passed directly to calculate_id(). submit_disc DISC_DETAILS submit_disc() submits a disc record to a cddbp server. Currently it only uses e-mail, although it will try different ways to send that. It returns true or false depending on whether it was able to send the submission e-mail. The rest of CDDB.pm will work without the ability to submit discs. While cddbp submissions are relatively rare, most CD collections will have one or two discs not present in the system. Please submit new discs to the system: the amazing number of existing discs got there because others submitted them before you needed them. submit_disc() takes six required parameters and two optional ones. The parameters are named, like hash elements, and can appear in any order. Genre => DISC_GENRE This is the disc's genre. It must be one of the genres that the server knows. See get_genres(). Id => CDDBP_ID This is the cddbp ID that identifies the disc. It should come from calculate_id() if this is a new submission, or from get_disc_details() if this is a revision. Artist => DISC_ARTIST This is the disc's artist, a freeform text field describing the party responsible for the album. It will need to be entered from the disc's notes for new submissions, or it can come from get_disc_details() on subsequent revisions. DiscTitle => DISC_TITLE This is the disc's title, a freeform text field describing the album. It must be entered from the disc's notes for new submissions. It can come from get_disc_details() on subsequent revisions. Offsets => TRACK_OFFSETS This is a reference to an array of absolute track offsets, as provided by calculate_id(). TrackTitles => TRACK_TITLES This is a reference to an array of track titles, either entered by a human or provided by get_disc_details(). From => EMAIL_ADDRESS This is the disc submitter's e-mail address. It's not required, and CDDB.pm will try to figure one out on its own if an address is omitted. It may be more reliable to provide your own, however. The default return address may not be a deliverable one, especially if CDDB.pm is being used on a dial-up machine that isn't running its own MTA. If the current machine has its own MTA, problems still may occur if the machine's Internet address changes. Host => SMTP_HOST This is the SMTP host to contact when sending mail. It's not required, and CDDB.pm will try to figure one out on its own. It will look at the SMTPHOSTS environment variable is not defined, it will try 'mail' and 'localhost' before finally failing. Revision => REVISION The revision number. Should be 1 for new submissions, and one higher than the previous one for updates. The previous revision number is available as the "revision" field in the hash returned by get_disc_details(). PRIVATE METHODS Documented as being not documented. EXAMPLES Please see the cddb.t program in the t (tests) directory. It exercises every aspect of CDDB.pm, including submissions. COMPATIBILITY CDDB.pm uses standard Perl modules. It has been tested at one point or another on OS/2, MacOS and FreeBSD systems, as well as the systems listed at: http://testers.cpan.org/search?request=dist&dist=CDDB If you want to submit disc information to the CDDB, you will need to install two other modules: Mail::Internet will allow CDDB.pm to send email submissions, and it automagically includes Mail::Header. MIME::QuotedPrint will allow CDDB.pm to send non-ASCII text unscathed. Currently only ISO-8859-1 and ASCII are supported. All other features will work without these modules. KNOWN TEST FAILURES The last test in the "make test" suite will try to send a sample submission to the CDDB if MailTools is present. It expects to find an SMTP host in the SMTPHOST environment variable. It will fall back to "mail" if SMTPHOST doesn't exist. If neither works, the test will be skipped. To see why it's skipped: make test TEST_VERBOSE=1 Some of the tests (most notably numbers 25, 27 and 29) compare data returned by a cddbp server against a stored copy of a previous query. These tests fail occasionally since the database is constantly in flux. Starting with version 1.00, the test program uses fuzzy comparisons that should fail less. Version 1.04 saw even fuzzier comparisons. Please report any problems so they can be fixed. LINKS BUG TRACKER https://rt.cpan.org/Dist/Display.html?Status=Active&Queue=CDDB REPOSITORY http://github.com/rcaputo/cddb-perl http://gitorious.org/cddb-freedb-perl OTHER RESOURCES http://search.cpan.org/dist/CDDB/ CONTACT AND COPYRIGHT Copyright 1998-2013 Rocco Caputo. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. CDDB-1.222/README.mkdn000644 000765 000024 00000054314 12203077571 014151 0ustar00trocstaff000000 000000 # NAME CDDB.pm - a high-level interface to cddb protocol servers (freedb and CDDB) # VERSION version 1.222 # SYNOPSIS use CDDB; ### Connect to the cddbp server. my $cddbp = new CDDB( Host => 'freedb.freedb.org', # default Port => 8880, # default Login => $login_id, # defaults to %ENV's ) or die $!; ### Retrieve known genres. my @genres = $cddbp->get_genres(); ### Calculate cddbp ID based on MSF info. my @toc = ( '1 0 2 37', # track, CD-i MSF (space-delimited) '999 1 38 17', # lead-out track MSF '1000 0 0 Error!', # error track (don't include if ok) ); my ( $cddbp_id, # used for further cddbp queries $track_numbers, # padded with 0's (for convenience) $track_lengths, # length of each track, in MM:SS format $track_offsets, # absolute offsets (used for further cddbp queries) $total_seconds # total play time, in seconds (for cddbp queries) ) = $cddbp->calculate_id(@toc); ### Query discs based on cddbp ID and other information. my @discs = $cddbp->get_discs($cddbp_id, $track_offsets, $total_seconds); foreach my $disc (@discs) { my ($genre, $cddbp_id, $title) = @$disc; } ### Query disc details (usually done with get_discs() information). my $disc_info = $cddbp->get_disc_details($genre, $cddbp_id); my $disc_time = $disc_info->{'disc length'}; my $disc_id = $disc_info->{discid}; my $disc_title = $disc_info->{dtitle}; my @track_offsets = @{$disc_info->{offsets}}; my @track_seconds = @{$disc_info->{seconds}}; my @track_titles = @{$disc_info->{ttitles}}; # other information may be returned... explore! ### Submit a disc via e-mail. (Requires MailTools) die "can't submit a disc (no mail modules; see README)" unless $cddbp->can_submit_disc(); # These are useful for prompting the user to fix defaults: print "I will send mail through: ", $cddbp->get_mail_host(), "\n"; print "I assume your e-mail address is: ", $cddbp->get_mail_address(), "\n"; # Actually submit a disc record. $cddbp->submit_disc( Genre => 'classical', Id => 'b811a20c', Artist => 'Various', DiscTitle => 'Cartoon Classics', Offsets => $disc_info->{offsets}, # array reference TrackTitles => $disc_info->{ttitles}, # array reference From => 'login@host.domain.etc', # will try to determine ); # DESCRIPTION CDDB protocol (cddbp) servers provide compact disc information for programs that need it. This allows such programs to display disc and track titles automatically, and it provides extended information like liner notes and lyrics. This module provides a high-level Perl interface to cddbp servers. With it, a Perl program can identify and possibly gather details about a CD based on its "table of contents" (the disc's track times and offsets). Disc details have been useful for generating CD catalogs, naming mp3 files, printing CD liners, or even just playing discs in an automated jukebox. Despite the module's name, it connects to FreeDB servers by default. This began at version 1.04, when cddb.com changed its licensing model to support end-user applications, not third-party libraries. Connections to cddb.com may still work, and patches are welcome to maintain that functionality, but it's no longer officially supported. # PUBLIC METHODS - new PARAMETERS Creates a high-level interface to a cddbp server, returning a handle to it. The handle is not a filehandle. It is an object. The new() constructor provides defaults for just about everything, but everything is overrideable if the defaults aren't appropriate. The interface will not actually connect to a cddbp server until it's used, and a single cddbp interface may actually make several connections (to possibly several servers) over the course of its use. The new() constructor accepts several parameters, all of which have reasonable defaults. __Host__ and __Port__ describe the cddbp server to connect to. These default to 'freedb.freedb.org' and 8880, which is a multiplexor for all the other freedb servers. __Utf8__ is a boolean flag. If true, utf-8 will be used when submitting CD info, and for interpreting the data reveived. This requires the [Encode](http://search.cpan.org/perldoc?Encode) module (and probably perl version at least 5.8.0). The default is true if the [Encode](http://search.cpan.org/perldoc?Encode) module can be loaded. Otherwise, it will be false, meaning we fall back to ASCII. __Protocol\_Version__ sets the cddbp version to use. CDDB.pm will not connect to servers that don't support the version specified here. The requested protocol version defaults to 1 if __Utf8__ is off, and to 6 if it is on. __Login__ is the login ID you want to advertise to the cddbp server. It defaults to the login ID your computer assigns you, if that can be determined. The default login ID is determined by the presence of a LOGNAME or USER environment variable, or by the getpwuid() function. On Windows systems, it defaults to "win32usr" if no default method can be found and no Login parameter is set. __Submit\_Address__ is the e-mail address where new disc submissions go. This defaults to 'freedb-submit@freedb.org'. Note, that testing submissions should be done via `test-submit@freedb.org`. __Client\_Name__ and __Client\_Version__ describe the client software used to connect to the cddbp server. They default to 'CDDB.pm' and CDDB.pm's version number. If developers change this, please consult freedb's web site for a list of client names already in use. __Debug__ enables verbose operational information on STDERR when set to true. It's normally not needed, but it can help explain why a program is failing. If someone finds a reproduceable bug, the Debug output and a test program would be a big help towards having it fixed. In case of submission, if this flag is on, a copy of the submission e-mail will be sent to the _From_ address. - get\_genres Takes no parameters. Returns a list of genres known by the cddbp server, or undef if there is a problem retrieving them. - calculate\_id TOC The cddb protocol defines an ID as a hash of track lengths and the number of tracks, with an added checksum. The most basic information required to calculate this is the CD table of contents (the CD-i track offsets, in "MSF" \[Minutes, Seconds, Frames\] format). Note however that there is no standard way to acquire this information from a CD-ROM device. Therefore this module does not try to read the TOC itself. Instead, developers must combine CDDB.pm with a CD library which works with their system. The AudioCD suite of modules is recommended: it has system specific code for MacOS, Linux and FreeBSD. CDDB.pm's author has used external programs like dagrab to fetch the offsets. Actual CDs aren't always necessary: the author has heard of people generating TOC information from mp3 file lengths. That said, see parse\_cdinfo() for a routine to parse "cdinfo" output into a table of contents list suitable for calculate\_id(). calculate\_id() accepts TOC information as a list of strings. Each string contains four fields, separated by whitespace: offset 0: the track number Track numbers start with 1 and run sequentially through the number of tracks on a disc. Note: data tracks count on hybrid audio/data CDs. CDDB.pm understands two special track numbers. Track 999 holds the lead-out information, which is required by the cddb protocol. Track 1000 holds information about errors which have occurred while physically reading the disc. offset 1: the track start time, minutes field Tracks are often addressed on audio CDs using "MSF" offsets. This stands for Minutes, Seconds, and Frames (fractions of a second). The combination pinpoints the exact disc frame where a song starts. Field 1 contains the M part of MSF. It is ignored for error tracks, but it still must contain a number. Zero is suggested. offset 2: the track start time, seconds field This field contains the S part of MSF. It is ignored for error tracks, but it still must contain a number. Zero is suggested. offset 3: the track start time, frames field This field contains the F part of MSF. For error tracks, it contains a description of the error. Example track file. Note: the comments should not appear in the file. 1 0 2 37 # track 1 starts at 00:02 and 37 frames 2 1 38 17 # track 2 starts at 01:38 and 17 frames 3 11 57 30 # track 3 starts at 11:57 and 30 frames ... 999 75 16 5 # leadout starts at 75:16 and 5 frames Track 1000 should not be present if everything is okay: 1000 0 0 Error reading TOC: no disc in drive In scalar context, calculate\_id() returns just the cddbp ID. In a list context, it returns an array containing the following values: ( $cddbp_id, $track_numbers, $track_lengths, $track_offsets, $total_seconds ) = $cddbp->calculate_id(@toc); print( "cddbp ID = $cddbp_id\n", # b811a20c "track numbers = @$track_numbers\n", # 001 002 003 ... "track lengths = @$track_lengths\n", # 01:36 10:19 04:29 ... "track offsets = @$track_offsets\n", # 187 7367 53805 ... "total seconds = $total_seconds\n", # 4514 ); CDDBP\_ID The 0th returned value is the hashed cddbp ID, required for any queries or submissions involving this disc. TRACK\_NUMBERS The 1st returned value is a reference to a list of track numbers, one for each track (excluding the lead-out), padded to three characters with leading zeroes. These values are provided for convenience, but they are not required by cddbp servers. TRACK\_LENGTHS The 2nd returned value is a reference to a list of track lengths, one for each track (excluding the lead-out), in HH:MM format. These values are returned as a convenience. They are not required by cddbp servers. TRACK\_OFFSETS The 3rd returned value is a reference to a list of absolute track offsets, in frames. They are calculated from the MSF values, and they are required by get\_discs() and submit\_disc(). TOTAL\_SECONDS The 4th and final value is the total playing time for the CD, in seconds. The get\_discs() function needs it. - get\_discs CDDBP\_ID, TRACK\_OFFSETS, TOTAL\_SECONDS get\_discs() asks the cddbp server for a summary of all the CDs matching a given cddbp ID, track offsets, and total playing time. These values can be retrieved from calculade\_id(). my @id_info = $cddbp->calculate_id(@toc); my $cddbp_id = $id_info->[0]; my $track_offsets = $id_info->[3]; my $total_seconds = $id_info->[4]; get\_discs() returns an array of matching discs, each of which is represented by an array reference. It returns an empty array if the query succeeded but did not match, and it returns undef on error. my @discs = $cddbp->get_discs( $cddbp_id, $track_offsets, $total_seconds ); foreach my $disc (@discs) { my ($disc_genre, $disc_id, $disc_title) = @$disc; print( "disc id = $disc_id\n", "disc genre = $disc_genre\n", "disc title = $disc_title\n", ); } DISC\_GENRE is the genre this disc falls into, as determined by whoever submitted or last edited the disc. The genre is required when requesting a disc's details. See get\_genres() for how to retrieve a list of cddbp genres. CDDBP\_ID is the cddbp ID of this disc. Cddbp servers perform fuzzy matches, returning near misses as well as direct hits on a cddbp ID, so knowing the exact ID for a disc is important when submitting changes or requesting a particular near-miss' details. DISC\_TITLE is the disc's title, which may help a human to pick the correct disc out of several close mathches. - get\_discs\_by\_toc TOC This function acts as a macro, combining calculate\_id() and get\_discs() calls into one function. It takes the same parameters as calculate\_id(), and it returns the same information as get\_discs(). - get\_discs\_by\_query QUERY\_STRING Fetch discs by a pre-built cddbp query string. Some disc querying programs report this string, and get\_discs\_by\_query() is a convenient way to use that. Cddb protocol query strings look like: cddb query $cddbp_id $track_count @offsets $total_seconds - get\_disc\_details DISC\_GENRE, CDDBP\_ID This function fetches a disc's detailed information from a cddbp server. It takes two parameters: the DISC\_GENRE and the CDDP\_ID. These parameters usually come from a call to get\_discs(). The disc's details are returned in a reference to a fairly complex hash. It includes information normally stored in comments. The most common entries in this hash include: $disc_details = get_disc_details( $disc_genre, $cddbp_id ); $disc\_details->{"disc length"} The disc length is commonly stored in the form "\#\#\# seconds", where \#\#\# is the disc's total playing time in seconds. It may hold other time formats. $disc\_details->{discid} This is a rehash (get it?) of the cddbp ID. It should match the CDDBP\_ID given to get\_disc\_details(). $disc\_details->{dtitle} This is the disc's title. I do not know whether it will match the one returned by get\_discs(). $disc\_details->{offsets} This is a reference to a list of absolute disc track offsets, similar to the TRACK\_OFFSETS returned by calculate\_id(). $disc\_details->{seconds} This is a reference to a list of track length, in seconds. $disc\_details->{ttitles} This is a reference to a list of track titles. These are the droids you are looking for. $disc\_details->{"processed by"} This is a comment field identifying the name and version of the cddbp server which accepted and entered the disc record into the database. $disc\_details->{revision} This is the disc record's version number, used as a sanity check (semaphore?) to prevent simultaneous revisions. Revisions start at 0 for new submissions and are incremented for every correction. It is the responsibility of the submitter (be it a person or a program using CDDB.pm) to provide a correct revision number. $disc\_details->{"submitted via"} This is the name and version of the software that submitted this cddbp record. The main intention is to identify records that are submitted by broken software so they can be purged or corrected. $disc\_details->{xmcd\_record} The xmcd\_record field contains a copy of the entire unprocessed cddbp response that generated all the other fields. $disc\_details->{genre} This is merely a copy of DISC\_GENRE, since it's otherwise not possible to determine it from the hash. - parse\_xmcd\_file XMCD\_FILE\_CONTENTS, \[GENRE\] Parses an array ref of lines read from an XMCD file into the disc\_details hash described above. If the GENRE parameter is set it will be included in disc\_details. - can\_submit\_disc Returns true or false, depending on whether CDDB.pm has enough dependent modules to submit discs. If it returns false, you are missing Mail::Internet, Mail::Header, or MIME::QuotedPrint. - get\_mail\_address Returns what CDDB.pm thinks your e-mail address is, or what it was last set to. It was added to fetch the default e-mail address so users can see it and have an opportunity to correct it. my $mail_from = $cddb->get_mail_address(); print "New e-mail address (or blank to keep <$mail_from>): "; my $new_mail_from = ; $new_mail_from =~ s/^\s+//; $new_mail_from =~ s/\s+$//; $new_mail_from =~ s/\s+/ /g; $mail_from = $new_mail_from if length $new_mail_from; $cddbp->submit_disc( ..., From => $mail_from, ); - get\_mail\_host Returns what CDDB.pm thinks your SMTP host is, or what it was last set to. It was added to fetch the default e-mail transfer host so users can see it and have an opportunity to correct it. my $mail_host = $cddb->get_mail_host(); print "New e-mail host (or blank to keep <$mail_host>): "; my $new_mail_host = ; $new_mail_host =~ s/^\s+//; $new_mail_host =~ s/\s+$//; $new_mail_host =~ s/\s+/ /g; $mail_host = $new_mail_host if length $new_mail_host; $cddbp->submit_disc( ..., Host => $mail_host, ); - parse\_cdinfo CDINFO\_FILE Generates a table of contents suitable for calculate\_id() based on the output of a program called "cdinfo". CDINFO\_FILE may either be a text file, or it may be the cdinfo program itself. my @toc = parse_cdinfo("cdinfo.txt"); # read cdinfo.txt my @toc = parse_cdinfo("cdinfo|"); # run cdinfo directly The table of contents can be passed directly to calculate\_id(). - submit\_disc DISC\_DETAILS submit\_disc() submits a disc record to a cddbp server. Currently it only uses e-mail, although it will try different ways to send that. It returns true or false depending on whether it was able to send the submission e-mail. The rest of CDDB.pm will work without the ability to submit discs. While cddbp submissions are relatively rare, most CD collections will have one or two discs not present in the system. Please submit new discs to the system: the amazing number of existing discs got there because others submitted them before you needed them. submit\_disc() takes six required parameters and two optional ones. The parameters are named, like hash elements, and can appear in any order. Genre => DISC\_GENRE This is the disc's genre. It must be one of the genres that the server knows. See get\_genres(). Id => CDDBP\_ID This is the cddbp ID that identifies the disc. It should come from calculate\_id() if this is a new submission, or from get\_disc\_details() if this is a revision. Artist => DISC\_ARTIST This is the disc's artist, a freeform text field describing the party responsible for the album. It will need to be entered from the disc's notes for new submissions, or it can come from get\_disc\_details() on subsequent revisions. DiscTitle => DISC\_TITLE This is the disc's title, a freeform text field describing the album. It must be entered from the disc's notes for new submissions. It can come from get\_disc\_details() on subsequent revisions. Offsets => TRACK\_OFFSETS This is a reference to an array of absolute track offsets, as provided by calculate\_id(). TrackTitles => TRACK\_TITLES This is a reference to an array of track titles, either entered by a human or provided by get\_disc\_details(). From => EMAIL\_ADDRESS This is the disc submitter's e-mail address. It's not required, and CDDB.pm will try to figure one out on its own if an address is omitted. It may be more reliable to provide your own, however. The default return address may not be a deliverable one, especially if CDDB.pm is being used on a dial-up machine that isn't running its own MTA. If the current machine has its own MTA, problems still may occur if the machine's Internet address changes. Host => SMTP\_HOST This is the SMTP host to contact when sending mail. It's not required, and CDDB.pm will try to figure one out on its own. It will look at the SMTPHOSTS environment variable is not defined, it will try 'mail' and 'localhost' before finally failing. Revision => REVISION The revision number. Should be 1 for new submissions, and one higher than the previous one for updates. The previous revision number is available as the `revision` field in the hash returned by get\_disc\_details(). # PRIVATE METHODS Documented as being not documented. # EXAMPLES Please see the cddb.t program in the t (tests) directory. It exercises every aspect of CDDB.pm, including submissions. # COMPATIBILITY CDDB.pm uses standard Perl modules. It has been tested at one point or another on OS/2, MacOS and FreeBSD systems, as well as the systems listed at: http://testers.cpan.org/search?request=dist&dist=CDDB If you want to submit disc information to the CDDB, you will need to install two other modules: Mail::Internet will allow CDDB.pm to send email submissions, and it automagically includes Mail::Header. MIME::QuotedPrint will allow CDDB.pm to send non-ASCII text unscathed. Currently only ISO-8859-1 and ASCII are supported. All other features will work without these modules. # KNOWN TEST FAILURES The last test in the "make test" suite will try to send a sample submission to the CDDB if MailTools is present. It expects to find an SMTP host in the SMTPHOST environment variable. It will fall back to "mail" if SMTPHOST doesn't exist. If neither works, the test will be skipped. To see why it's skipped: make test TEST_VERBOSE=1 Some of the tests (most notably numbers 25, 27 and 29) compare data returned by a cddbp server against a stored copy of a previous query. These tests fail occasionally since the database is constantly in flux. Starting with version 1.00, the test program uses fuzzy comparisons that should fail less. Version 1.04 saw even fuzzier comparisons. Please report any problems so they can be fixed. # LINKS ## BUG TRACKER https://rt.cpan.org/Dist/Display.html?Status=Active&Queue=CDDB ## REPOSITORY http://github.com/rcaputo/cddb-perl http://gitorious.org/cddb-freedb-perl ## OTHER RESOURCES http://search.cpan.org/dist/CDDB/ # CONTACT AND COPYRIGHT Copyright 1998-2013 Rocco Caputo. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. CDDB-1.222/t/000755 000765 000024 00000000000 12203077571 012575 5ustar00trocstaff000000 000000 CDDB-1.222/t/000-report-versions.t000644 000765 000024 00000031270 12203077571 016443 0ustar00trocstaff000000 000000 #!perl use warnings; use strict; use Test::More 0.94; # Include a cut-down version of YAML::Tiny so we don't introduce unnecessary # dependencies ourselves. package Local::YAML::Tiny; use strict; use Carp 'croak'; # UTF Support? sub HAVE_UTF8 () { $] >= 5.007003 } BEGIN { if ( HAVE_UTF8 ) { # The string eval helps hide this from Test::MinimumVersion eval "require utf8;"; die "Failed to load UTF-8 support" if $@; } # Class structure require 5.004; $YAML::Tiny::VERSION = '1.40'; # Error storage $YAML::Tiny::errstr = ''; } # Printable characters for escapes my %UNESCAPES = ( z => "\x00", a => "\x07", t => "\x09", n => "\x0a", v => "\x0b", f => "\x0c", r => "\x0d", e => "\x1b", '\\' => '\\', ); ##################################################################### # Implementation # Create an empty YAML::Tiny object sub new { my $class = shift; bless [ @_ ], $class; } # Create an object from a file sub read { my $class = ref $_[0] ? ref shift : shift; # Check the file my $file = shift or return $class->_error( 'You did not specify a file name' ); return $class->_error( "File '$file' does not exist" ) unless -e $file; return $class->_error( "'$file' is a directory, not a file" ) unless -f _; return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _; # Slurp in the file local $/ = undef; local *CFG; unless ( open(CFG, $file) ) { return $class->_error("Failed to open file '$file': $!"); } my $contents = ; unless ( close(CFG) ) { return $class->_error("Failed to close file '$file': $!"); } $class->read_string( $contents ); } # Create an object from a string sub read_string { my $class = ref $_[0] ? ref shift : shift; my $self = bless [], $class; my $string = $_[0]; unless ( defined $string ) { return $self->_error("Did not provide a string to load"); } # Byte order marks # NOTE: Keeping this here to educate maintainers # my %BOM = ( # "\357\273\277" => 'UTF-8', # "\376\377" => 'UTF-16BE', # "\377\376" => 'UTF-16LE', # "\377\376\0\0" => 'UTF-32LE' # "\0\0\376\377" => 'UTF-32BE', # ); if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) { return $self->_error("Stream has a non UTF-8 BOM"); } else { # Strip UTF-8 bom if found, we'll just ignore it $string =~ s/^\357\273\277//; } # Try to decode as utf8 utf8::decode($string) if HAVE_UTF8; # Check for some special cases return $self unless length $string; unless ( $string =~ /[\012\015]+\z/ ) { return $self->_error("Stream does not end with newline character"); } # Split the file into lines my @lines = grep { ! /^\s*(?:\#.*)?\z/ } split /(?:\015{1,2}\012|\015|\012)/, $string; # Strip the initial YAML header @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines; # A nibbling parser while ( @lines ) { # Do we have a document header? if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) { # Handle scalar documents shift @lines; if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) { push @$self, $self->_read_scalar( "$1", [ undef ], \@lines ); next; } } if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) { # A naked document push @$self, undef; while ( @lines and $lines[0] !~ /^---/ ) { shift @lines; } } elsif ( $lines[0] =~ /^\s*\-/ ) { # An array at the root my $document = [ ]; push @$self, $document; $self->_read_array( $document, [ 0 ], \@lines ); } elsif ( $lines[0] =~ /^(\s*)\S/ ) { # A hash at the root my $document = { }; push @$self, $document; $self->_read_hash( $document, [ length($1) ], \@lines ); } else { croak("YAML::Tiny failed to classify the line '$lines[0]'"); } } $self; } # Deparse a scalar string to the actual scalar sub _read_scalar { my ($self, $string, $indent, $lines) = @_; # Trim trailing whitespace $string =~ s/\s*\z//; # Explitic null/undef return undef if $string eq '~'; # Quotes if ( $string =~ /^\'(.*?)\'\z/ ) { return '' unless defined $1; $string = $1; $string =~ s/\'\'/\'/g; return $string; } if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) { # Reusing the variable is a little ugly, # but avoids a new variable and a string copy. $string = $1; $string =~ s/\\"/"/g; $string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex; return $string; } # Special cases if ( $string =~ /^[\'\"!&]/ ) { croak("YAML::Tiny does not support a feature in line '$lines->[0]'"); } return {} if $string eq '{}'; return [] if $string eq '[]'; # Regular unquoted string return $string unless $string =~ /^[>|]/; # Error croak("YAML::Tiny failed to find multi-line scalar content") unless @$lines; # Check the indent depth $lines->[0] =~ /^(\s*)/; $indent->[-1] = length("$1"); if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) { croak("YAML::Tiny found bad indenting in line '$lines->[0]'"); } # Pull the lines my @multiline = (); while ( @$lines ) { $lines->[0] =~ /^(\s*)/; last unless length($1) >= $indent->[-1]; push @multiline, substr(shift(@$lines), length($1)); } my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n"; my $t = (substr($string, 1, 1) eq '-') ? '' : "\n"; return join( $j, @multiline ) . $t; } # Parse an array sub _read_array { my ($self, $array, $indent, $lines) = @_; while ( @$lines ) { # Check for a new document if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) { while ( @$lines and $lines->[0] !~ /^---/ ) { shift @$lines; } return 1; } # Check the indent level $lines->[0] =~ /^(\s*)/; if ( length($1) < $indent->[-1] ) { return 1; } elsif ( length($1) > $indent->[-1] ) { croak("YAML::Tiny found bad indenting in line '$lines->[0]'"); } if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) { # Inline nested hash my $indent2 = length("$1"); $lines->[0] =~ s/-/ /; push @$array, { }; $self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines ); } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) { # Array entry with a value shift @$lines; push @$array, $self->_read_scalar( "$2", [ @$indent, undef ], $lines ); } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) { shift @$lines; unless ( @$lines ) { push @$array, undef; return 1; } if ( $lines->[0] =~ /^(\s*)\-/ ) { my $indent2 = length("$1"); if ( $indent->[-1] == $indent2 ) { # Null array entry push @$array, undef; } else { # Naked indenter push @$array, [ ]; $self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines ); } } elsif ( $lines->[0] =~ /^(\s*)\S/ ) { push @$array, { }; $self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines ); } else { croak("YAML::Tiny failed to classify line '$lines->[0]'"); } } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) { # This is probably a structure like the following... # --- # foo: # - list # bar: value # # ... so lets return and let the hash parser handle it return 1; } else { croak("YAML::Tiny failed to classify line '$lines->[0]'"); } } return 1; } # Parse an array sub _read_hash { my ($self, $hash, $indent, $lines) = @_; while ( @$lines ) { # Check for a new document if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) { while ( @$lines and $lines->[0] !~ /^---/ ) { shift @$lines; } return 1; } # Check the indent level $lines->[0] =~ /^(\s*)/; if ( length($1) < $indent->[-1] ) { return 1; } elsif ( length($1) > $indent->[-1] ) { croak("YAML::Tiny found bad indenting in line '$lines->[0]'"); } # Get the key unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+|$)// ) { if ( $lines->[0] =~ /^\s*[?\'\"]/ ) { croak("YAML::Tiny does not support a feature in line '$lines->[0]'"); } croak("YAML::Tiny failed to classify line '$lines->[0]'"); } my $key = $1; # Do we have a value? if ( length $lines->[0] ) { # Yes $hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines ); } else { # An indent shift @$lines; unless ( @$lines ) { $hash->{$key} = undef; return 1; } if ( $lines->[0] =~ /^(\s*)-/ ) { $hash->{$key} = []; $self->_read_array( $hash->{$key}, [ @$indent, length($1) ], $lines ); } elsif ( $lines->[0] =~ /^(\s*)./ ) { my $indent2 = length("$1"); if ( $indent->[-1] >= $indent2 ) { # Null hash entry $hash->{$key} = undef; } else { $hash->{$key} = {}; $self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines ); } } } } return 1; } # Set error sub _error { $YAML::Tiny::errstr = $_[1]; undef; } # Retrieve error sub errstr { $YAML::Tiny::errstr; } ##################################################################### # Use Scalar::Util if possible, otherwise emulate it BEGIN { eval { require Scalar::Util; }; if ( $@ ) { # Failed to load Scalar::Util eval <<'END_PERL'; sub refaddr { my $pkg = ref($_[0]) or return undef; if (!!UNIVERSAL::can($_[0], 'can')) { bless $_[0], 'Scalar::Util::Fake'; } else { $pkg = undef; } "$_[0]" =~ /0x(\w+)/; my $i = do { local $^W; hex $1 }; bless $_[0], $pkg if defined $pkg; $i; } END_PERL } else { Scalar::Util->import('refaddr'); } } ##################################################################### # main test ##################################################################### package main; BEGIN { # Skip modules that either don't want to be loaded directly, such as # Module::Install, or that mess with the test count, such as the Test::* # modules listed here. # # Moose::Role conflicts if Moose is loaded as well, but Moose::Role is in # the Moose distribution and it's certain that someone who uses # Moose::Role also uses Moose somewhere, so if we disallow Moose::Role, # we'll still get the relevant version number. my %skip = map { $_ => 1 } qw( App::FatPacker Class::Accessor::Classy Devel::Cover Module::Install Moose::Role POE::Loop::Tk Template::Test Test::Kwalitee Test::Pod::Coverage Test::Portability::Files Test::YAML::Meta open ); my $Test = Test::Builder->new; $Test->plan(skip_all => "META.yml could not be found") unless -f 'META.yml' and -r _; my $meta = (Local::YAML::Tiny->read('META.yml'))->[0]; my %requires; for my $require_key (grep { /requires/ } keys %$meta) { my %h = %{ $meta->{$require_key} }; $requires{$_}++ for keys %h; } delete $requires{perl}; diag("Testing with Perl $], $^X"); for my $module (sort keys %requires) { if ($skip{$module}) { note "$module doesn't want to be loaded directly, skipping"; next; } local $SIG{__WARN__} = sub { note "$module: $_[0]" }; require_ok $module or BAIL_OUT("can't load $module"); my $version = $module->VERSION; $version = 'undefined' unless defined $version; diag(" $module version is $version"); } done_testing; } CDDB-1.222/t/01_cddb.t000644 000765 000024 00000016355 12203077571 014170 0ustar00trocstaff000000 000000 #!perl -w # vim: filetype=perl # # Copyright 1998-2020 Rocco Caputo . All rights # reserved. This program is free software; you can redistribute it # and/or modify it under the same terms as Perl itself. use strict; use CDDB; use Test::More tests => 25; BEGIN { select(STDOUT); $|=1; }; my ($i, $result); ### test connecting my $cddb = new CDDB( Host => 'freedb.freedb.org', Port => 8880, Submit_Address => 'test-submit@freedb.org', Debug => 0, ); ok(defined($cddb), "cddb object built okay"); ### test genres my @test_genres = sort qw( blues classical country data folk jazz misc newage reggae rock soundtrack ); my @cddb_genres = sort $cddb->get_genres(); is_deeply(\@cddb_genres, \@test_genres, "got expected genres"); ### helper sub: replace != tests with "not off by 5%" sub not_near { my ($live, $test) = @_; return (abs($live-$test) > ($test * 0.05)); } ### sample TOC info for next few tests # A CD table of contents is a list of tracks acquired from whatever Your # Particular Operating System uses to manage CD-ROMs. Often, it's some # sort of API or ioctl() interface. You're on your own here. # # Whatever you use should return the TOC as a list of whitespace-delimited # records. Each record should have three fields: the track number, the # minutes offset of the track's beginning, the seconds offset of the track's # beginning, and the leftover frames of the track's offset. In other words, # track_number M S F (where M S and F are defined in the CD-I spec.) # # Special information is indicated by these "virtual" track numbers: # 999: lead-out information (same as regular track format) # 1000: error reading TOC (minutes and seconds are unused; frame # contains a text message describing the error) # # Sample TOC information: my @toc = ( "1 0 3 71", # track 1 starts at 00:03 and 71 frames "999 5 44 4", # leadout starts at 05:44 and 4 frames ); ### calculate CDDB ID my ($id, $track_numbers, $track_lengths, $track_offsets, $total_seconds) = $cddb->calculate_id(@toc); is($id, '03015501', 'calculated expected id'); is($total_seconds, 344, 'total time matches'); my @test_numbers = qw(001); my @test_lengths = qw(05:41); my @test_offsets = qw(296); is_deeply($track_numbers, \@test_numbers, 'got expected track numbers'); is_deeply($track_lengths, \@test_lengths, 'got expected track lengths'); is_deeply($track_offsets, \@test_offsets, 'got expected track offsets'); ### test looking up discs (one match) my @discs = $cddb->get_discs($id, $track_offsets, $total_seconds); my $disc_count = @discs; my ($genre, $disc_id, $title) = @{$discs[0]}; is($disc_count, 2, 'got expected disc count'); ok(scalar(grep { $_->[0] eq 'misc' } @discs), 'got expected disc genre'); ok(scalar(grep { $_->[1] eq '03015501' } @discs), 'retrieved disc is expected id'); #is($discs[0][1], '03015501', 'retrieved disc is expected id'); like($discs[0][2], qr/freedb.*test/i, 'retrieved disc has expected title'); ### test macro lookup $cddb->disconnect(); my @other_discs = $cddb->get_discs_by_toc(@toc); is_deeply($other_discs[0], $discs[0], 'disc by toc matches disc by id'); ### test gathering disc details $cddb->disconnect(); my $disc_info = $cddb->get_disc_details($genre, $disc_id); # -><- uncomment if you'd like to see all the details # foreach my $key (sort keys(%$disc_info)) { # my $val = $disc_info->{$key}; # if (ref($val) eq 'ARRAY') { # print STDERR "\t$key: ", join('; ', @{$val}), "\n"; # } # else { # print STDERR "\t$key: $val\n"; # } # } is($disc_info->{'disc length'}, '344 seconds', 'disc is expected length'); is($disc_info->{'discid'}, $disc_id, 'disc id matches expectation'); is($disc_info->{'dtitle'}, $title, 'disc title matches expectation'); is_deeply($disc_info->{'offsets'}, $track_offsets, 'disc offsets match'); my @test_titles = ( "01-test" ); my $ok_tracks = 0; $i = 0; $result = 'ok'; foreach my $detail_title (@{$disc_info->{'ttitles'}}) { my ($detail_norm, $test_norm) = (lc($detail_title), lc($test_titles[$i++])); next unless $detail_norm eq $test_norm; $ok_tracks++; } ok($ok_tracks >= @test_titles / 2, 'enough track titles match expectation'); ### test fuzzy matches ("the freeside tests") $id = 'a70cfb0c'; $total_seconds = 3323; my @fuzzy_offsets = qw( 0 20700 37275 57975 78825 102525 128700 148875 167100 184500 209250 229500 ); @discs = $cddb->get_discs($id, \@fuzzy_offsets, $total_seconds); ok(scalar(@discs), 'retrieved at least one disc'); ($genre, $disc_id, $title) = @{$discs[0]}; ok((length $genre), 'retrieved disc has a genre'); ok((length($disc_id) == 8), 'retrieved disc id is proper length'); ok((length $title), 'retrieved disc has a title'); $id = 'c509b810'; $total_seconds = 2488; @fuzzy_offsets = qw( 0 11250 19125 33075 47850 58950 69075 80175 91500 105975 120225 142425 152325 163200 167850 182775 ); @discs = $cddb->get_discs($id, \@fuzzy_offsets, $total_seconds); ok(@discs > 1, 'retrieved discs from fuzzy offset'); ### test CDDB submission # dngor It's not Polite to have tests fail when things are OK, # Makes CPAN choke :( SKIP: { unless ($cddb->can_submit_disc()) { skip( "Mail::Internet; Mail::Header; and MIME::QuotedPrint needed to submit", 1 ); } eval { $cddb->submit_disc( Genre => 'classical', Id => 'b811a20c', # iso-8859-1 u with diaeresis (umlaut) for testing Artist => "Vario\xDCs", DiscTitle => 'Cartoon Classics', Offsets => $disc_info->{'offsets'}, TrackTitles => $disc_info->{'ttitles'}, # odd revision for testing Revision => 123, ); pass("submitted a test disc; check your e-mail for confirmation"); }; # skip if SMTPHOSTS and default are bad if ($@) { skip($@, 1); } }; ### Test fetch-by-query. my $query = ( "cddb query d30ffd0e 14 150 19705 40130 59947 77417 96730 109345" . " 131927 149287 167635 185130 206002 229075 279870 4095" ); @discs = $cddb->get_discs_by_query($query); is($discs[0][0], 'rock', 'fetch-by-query retrieved expected genre'); is($discs[0][1], 'd30ffd0e', 'fetch-by-query retrieved expected id'); __END__ sub developing { # CD-ROM interface $cd = new CDROM($device) or die $!; # loads CD TOC @toc = $cd->toc(); # returs an array like: $toc[0] = [ # track 999 is the lead-out information # track 1000 indicates an error $track_number, # next three fields are CD-i MSF information, broken apart $offset_minutes, $offset_seconds, $offset_frames, ]; # rips a track to a file $cd->rip(track => 2, file => '/tmp/track-2', format => 'wav') or die $!; $cd->rip(start => '12:34/0', stop => '15:57/0', file => '/tmp/msfrange', format => 'wav' ) or die $!; # synchronous methods wait for finish $cd->play(track => 1, method => synchronous); # asynch methods return right away $cd->play(track => 2, method => asynchronous); # returns what's going on ('playing', 'ripping', etc.) # used to poll the device during asynchronous operations? $cd->status(); # fill out the interface $cd->stop(); $cd->pause(); $cd->resume(); # whimsy. virtually useless stuff, but why not? $cd->seek(track => 1); $cd->seek(offset => '12:34/0'); $cd->seek(offset => '-0:34/0'); $cd->seek(offset => '+0:34/0'); } CDDB-1.222/t/release-pod-coverage.t000644 000765 000024 00000000765 12203077571 016763 0ustar00trocstaff000000 000000 #!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use Test::More; eval "use Test::Pod::Coverage 1.08"; plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage" if $@; eval "use Pod::Coverage::TrustPod"; plan skip_all => "Pod::Coverage::TrustPod required for testing POD coverage" if $@; all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); CDDB-1.222/t/release-pod-syntax.t000644 000765 000024 00000000450 12203077571 016505 0ustar00trocstaff000000 000000 #!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use Test::More; eval "use Test::Pod 1.41"; plan skip_all => "Test::Pod 1.41 required for testing POD" if $@; all_pod_files_ok(); CDDB-1.222/lib/CDDB.pm000644 000765 000024 00000136177 12203077571 014151 0ustar00trocstaff000000 000000 # Documentation and Copyright exist after __END__ package CDDB; require 5.001; use strict; use vars qw($VERSION); use Carp; $VERSION = '1.220'; BEGIN { if ($^O eq 'MSWin32') { eval 'sub USING_WINDOWS () { 1 }'; } else { eval 'sub USING_WINDOWS () { 0 }'; } } use IO::Socket; use Sys::Hostname; # A list of known freedb servers. I've stopped using Gracenote's CDDB # because they never return my e-mail about becoming a developer. To # top it off, they've started denying CDDB.pm users. # TODO: Fetch the list from freedb.freedb.org, which is a round-robin # for all the others anyway. my $cddbp_host_selector = 0; my @cddbp_hosts = ( [ 'localhost' => 8880 ], [ 'freedb.freedb.org' => 8880 ], [ 'us.freedb.org', => 8880 ], [ 'ca.freedb.org', => 8880 ], [ 'ca2.freedb.org', => 8880 ], [ 'uk.freedb.org' => 8880 ], [ 'no.freedb.org' => 8880 ], [ 'de.freedb.org' => 8880 ], [ 'at.freedb.org' => 8880 ], [ 'freedb.freedb.de' => 8880 ], ); #------------------------------------------------------------------------------ # Determine whether we can submit changes by e-mail. my $imported_mail = 0; eval { require Mail::Internet; require Mail::Header; require MIME::QuotedPrint; $imported_mail = 1; }; #------------------------------------------------------------------------------ # Determine whether we can use HTTP for requests and submissions. my $imported_http = 0; eval { require LWP; require HTTP::Request; $imported_http = 1; }; #------------------------------------------------------------------------------ # Send a command. If we're not connected, try to connect first. # Returns 1 if the command is sent ok; 0 if there was a problem. sub command { my $self = shift; my $str = join(' ', @_); unless ($self->{handle}) { $self->connect() or return 0; } $self->debug_print(0, '>>> ', $str); my $len = length($str .= "\x0D\x0A"); local $SIG{PIPE} = 'IGNORE' unless ($^O eq 'MacOS'); return 0 unless(syswrite($self->{handle}, $str, $len) == $len); return 1; } #------------------------------------------------------------------------------ # Retrieve a line from the server. Uses a buffer to allow for # ungetting lines. Returns the next line or undef if there is a # problem. sub getline { my $self = shift; if (@{$self->{lines}}) { my $line = shift @{$self->{lines}}; $self->debug_print(0, '<<< ', $line); return $line; } my $socket = $self->{handle}; return unless defined $socket; my $fd = fileno($socket); return unless defined $fd; vec(my $rin = '', $fd, 1) = 1; my $timeout = $self->{timeout} || undef; my $frame = $self->{frame}; until (@{$self->{lines}}) { # Fail if the socket is inactive for the timeout period. Fail # also if sysread returns nothing. return unless select(my $rout=$rin, undef, undef, $timeout); return unless defined sysread($socket, my $buf='', 1024); $frame .= $buf; my @lines = split(/\x0D?\x0A/, $frame); $frame = ( (length($buf) == 0 || substr($buf, -1, 1) eq "\x0A") ? '' : pop(@lines) ); push @{$self->{lines}}, map { decode('utf8', $_) } @lines; } $self->{frame} = $frame; my $line = shift @{$self->{lines}}; $self->debug_print(0, '<<< ', $line); return $line; } #------------------------------------------------------------------------------ # Receive a server response, and parse it into its numeric code and # text message. Return the code's first character, which usually # indicates the response class (ok, error, information, warning, # etc.). Returns undef on failure. sub response { my $self = shift; my ($code, $text); my $str = $self->getline(); return unless defined($str); # Fail if the line we get isn't the proper format. return unless ( ($code, $text) = ($str =~ /^(\d+)\s*(.*?)\s*$/) ); $self->{response_code} = $code; $self->{response_text} = $text; substr($code, 0, 1); } #------------------------------------------------------------------------------ # Accessors to retrieve the last response() call's code and text # separately. sub code { my $self = shift; $self->{response_code}; } sub text { my $self = shift; $self->{response_text}; } #------------------------------------------------------------------------------ # Helper to print stuff for debugging. sub debug_print { my $self = shift; # Don't bother if not debugging. return unless $self->{debug}; my $level = shift; my $text = join('', @_); print STDERR $text, "\n"; } #------------------------------------------------------------------------------ # Read data until it's terminated by a single dot on its own line. # Two dots at the start of a line are replaced by one. Returns an # ARRAY reference containing the lines received, or undef on error. sub read_until_dot { my $self = shift; my @lines; while ('true') { my $line = $self->getline() or return; last if ($line =~ /^\.$/); $line =~ s/^\.\././; push @lines, $line; } \@lines; } #------------------------------------------------------------------------------ # Create an object to represent one or more cddbp sessions. sub new { my $type = shift; my %param = @_; # Attempt to suss our hostname. my $hostname = &hostname(); # Attempt to suss our login ID. my $login = $param{Login} || $ENV{LOGNAME} || $ENV{USER}; if (not defined $login) { if (USING_WINDOWS) { carp( "Can't get login ID. Use Login parameter or " . "set LOGNAME or USER environment variable. Using default login " . "ID 'win32usr'" ); $login = 'win32usr'; } else { $login = getpwuid($>) or croak( "Can't get login ID. " . "Set LOGNAME or USER environment variable and try again: $!" ); } } # Debugging flag. my $debug = $param{Debug}; $debug = 0 unless defined $debug; # Choose a particular cddbp host. my $host = $param{Host}; $host = '' unless defined $host; # Choose a particular cddbp port. my $port = $param{Port}; $port = 8880 unless $port; # Choose a particular cddbp submission address. my $submit_to = $param{Submit_Address}; $submit_to = 'freedb-submit@freedb.org' unless defined $submit_to; # Change the cddbp client name. my $client_name = $param{Client_Name}; $client_name = 'CDDB.pm' unless defined $client_name; # Change the cddbp client version. my $client_version = $param{Client_Version}; $client_version = $VERSION unless defined $client_version; # Whether to use utf-8 for submission my $utf8 = $param{Utf8}; $utf8 = 1 unless defined $utf8; if ($utf8) { eval { require Encode; import Encode; }; if ( $@ ) { carp 'Unable to load the Encode module, falling back to ascii'; $utf8 = 0; } } eval 'sub encode { $_[1] };sub decode { $_[1] }' unless $utf8; # Change the cddbp protocol level. my $cddb_protocol = $param{Protocol_Version}; $cddb_protocol = ($utf8 ? 6 : 1) unless defined $cddb_protocol; carp < $hostname, login => $login, mail_from => undef, mail_host => undef, libname => $client_name, libver => $client_version, cddbmail => $submit_to, debug => $debug, host => $host, port => $port, cddb_protocol => $cddb_protocol, utf8 => $utf8, lines => [], frame => '', response_code => '000', response_text => '', }, $type; $self; } #------------------------------------------------------------------------------ # Disconnect from a cddbp server. This is needed sometimes when a # server decides a session has performed enough requests. sub disconnect { my $self = shift; if ($self->{handle}) { $self->command('quit'); # quit $self->response(); # wait for any response delete $self->{handle}; # close the socket } else { $self->debug_print( 0, '--- disconnect on unconnected handle' ); } } #------------------------------------------------------------------------------ # Connect to a cddbp server. Connecting and disconnecting are done # transparently and are performed on the basis of need. Furthermore, # this routine will cycle through servers until one connects or it has # exhausted all its possibilities. Returns true if successful, or # false if failed. sub connect { my $self = shift; my $cddbp_host; # Try to get our hostname yet again, in case it failed during the # constructor call. unless (defined $self->{hostname}) { $self->{hostname} = &hostname() or croak "can't get hostname: $!"; } # The handshake loop tries to complete an entire connection # negociation. It loops until success, or until HOST returns # because all the hosts have failed us. HANDSHAKE: while ('true') { # Loop through the CDDB protocol hosts list up to twice in order # to find a server that will respond. This implements a 2x retry. HOST: for (1..(@cddbp_hosts * 2)) { # Hard disconnect here to prevent recursion. delete $self->{handle}; ($self->{host}, $self->{port}) = @{$cddbp_hosts[$cddbp_host_selector]}; # Assign the host we selected, and attempt a connection. $self->debug_print( 0, "=== connecting to $self->{host} port $self->{port}" ); $self->{handle} = new IO::Socket::INET( PeerAddr => $self->{host}, PeerPort => $self->{port}, Proto => 'tcp', Timeout => 30, ); # The host did not answer. Clean up after the failed attempt # and cycle to the next host. unless (defined $self->{handle}) { $self->debug_print( 0, "--- error connecting to $self->{host} port $self->{port}: $!" ); delete $self->{handle}; $self->{host} = $self->{port} = ''; # Try the next host in the list. Wrap if necessary. $cddbp_host_selector = 0 if ++$cddbp_host_selector > @cddbp_hosts; next HOST; } # The host accepted our connection. We'll push it back on the # list of known cddbp hosts so it can be tried later. And we're # done with the host list cycle for now. $self->debug_print( 0, "+++ successfully connected to $self->{host} port $self->{port}" ); last HOST; } # Tried the whole list twice without success? Time to give up. unless (defined $self->{handle}) { $self->debug_print( 0, "--- all cddbp servers failed to answer" ); warn "No cddb protocol servers answer. Is your network OK?\n" unless $self->{debug}; return; } # Turn off buffering on the socket handle. select((select($self->{handle}), $|=1)[0]); # Get the server's banner message. Try reconnecting if it's bad. my $code = $self->response(); if ($code != 2) { $self->debug_print( 0, "--- bad cddbp response: ", $self->code(), ' ', $self->text() ); next HANDSHAKE; } # Say hello, and wait for a response. $self->command( 'cddb hello', $self->{login}, $self->{hostname}, $self->{libname}, $self->{libver} ); $code = $self->response(); if ($code == 4) { $self->debug_print( 0, "--- the server denies us: ", $self->code(), ' ', $self->text() ); return; } if ($code != 2) { $self->debug_print( 0, "--- the server didn't handshake: ", $self->code(), ' ', $self->text() ); next HANDSHAKE; } # Set the protocol level. if ($self->{cddb_protocol} != 1) { $self->command( 'proto', $self->{cddb_protocol} ); $code = $self->response(); if ($code != 2) { $self->debug_print( 0, "--- can't set protocol level ", $self->{cddb_protocol}, ' ', $self->code(), ' ', $self->text() ); return; } } # If we get here, everything succeeded. return 1; } } # Destroying the cddbp object disconnects from the server. sub DESTROY { my $self = shift; $self->disconnect(); } ############################################################################### # High-level cddbp functions. #------------------------------------------------------------------------------ # Get a list of available genres. Returns an array of genre names, or # undef on failure. sub get_genres { my $self = shift; my @genres; $self->command('cddb lscat'); my $code = $self->response(); return unless $code; if ($code == 2) { my $genres = $self->read_until_dot(); return @$genres if defined $genres; return; } $self->debug_print( 0, '--- error listing categories: ', $self->code(), ' ', $self->text() ); return; } #------------------------------------------------------------------------------ # Calculate a cddbp ID based on a text table of contents. The text # format was chosen because it was straightforward and easy to # generate. In a scalar context, this returns just the cddbp ID. In # a list context it returns several things: a listref of track # numbers, a listref of track lengths (MM:SS format), a listref of # track offsets (in seconds), and the disc's total playing time in # seconds. In either context it returns undef on failure. sub calculate_id { my $self = shift; my @toc = @_; my ( $seconds_previous, $seconds_first, $seconds_last, $cddbp_sum, @track_numbers, @track_lengths, @track_offsets, ); foreach my $line (@toc) { my ($track, $mm_begin, $ss_begin, $ff_begin) = split(/\s+/, $line, 4); my $frame_offset = (($mm_begin * 60 + $ss_begin) * 75) + $ff_begin; my $seconds_begin = int($frame_offset / 75); if (defined $seconds_previous) { my $elapsed = $seconds_begin - $seconds_previous; push( @track_lengths, sprintf("%02d:%02d", int($elapsed / 60), $elapsed % 60) ); } else { $seconds_first = $seconds_begin; } # Track 999 was chosen for the lead-out information. if ($track == 999) { $seconds_last = $seconds_begin; last; } # Track 1000 was chosen for error information. if ($track == 1000) { $self->debug_print( 0, "error in TOC: $ff_begin" ); return; } map { $cddbp_sum += $_; } split(//, $seconds_begin); push @track_offsets, $frame_offset; push @track_numbers, sprintf("%03d", $track); $seconds_previous = $seconds_begin; } # Calculate the ID. Whee! my $id = sprintf( "%02x%04x%02x", ($cddbp_sum % 255), $seconds_last - $seconds_first, scalar(@track_offsets) ); # In list context, we return several things. Some of them are # useful for generating filenames or playlists (the padded track # numbers). Others are needed for cddbp queries. return ( $id, \@track_numbers, \@track_lengths, \@track_offsets, $seconds_last ) if wantarray(); # Just return the cddbp ID in scalar context. return $id; } #------------------------------------------------------------------------------ # Parse cdinfo's output so calculate_id() can eat it. sub parse_cdinfo { my ($self, $command) = @_; open(FH, $command) or croak "could not open `$command': $!"; my @toc; while () { if (/(\d+):\s+(\d+):(\d+):(\d+)/) { my @track = ($1,$2,$3,$4); $track[0] = 999 if /leadout/; push @toc, "@track"; } } close FH; return @toc; } #------------------------------------------------------------------------------ # Get a list of discs that match a particular CD's table of contents. # This accepts the TOC information as returned by calculate_id(). It # will also accept information in mp3 format, but I forget what that # is. Pudge asked for it, so he'd know. sub get_discs { my $self = shift; my ($id, $offsets, $total_seconds) = @_; # Accept the TOC in CDDB.pm format. my ($track_count, $offsets_string); if (ref($offsets) eq 'ARRAY') { $track_count = scalar(@$offsets); $offsets_string = join ' ', @$offsets; } # Accept the TOC in mp3 format, for pudge. else { $offsets =~ /^(\d+?)\s+(.*)$/; $track_count = $1; $offsets_string = $2; } # Make repeated attempts to query the server. I do this to drive # the hidden server cycling. my $code; ATTEMPT: while ('true') { # Send a cddbp query command. $self->command( 'cddb query', $id, $track_count, $offsets_string, $total_seconds ) or return; # Get the response. Try again if the server is temporarly # unavailable. $code = $self->response(); next ATTEMPT if $self->code() == 417; last ATTEMPT; } # Return undef if there's a problem. return unless defined $code and $code == 2; # Single matching disc. if ($self->code() == 200) { my ($genre, $cddbp_id, $title) = ( $self->text() =~ /^(\S+)\s*(\S+)\s*(.*?)\s*$/ ); return [ $genre, $cddbp_id, $title ]; } # No matching discs. return if $self->code() == 202; # Multiple matching discs. # 210 Found exact matches, list follows (...) [proto>=4] # 211 Found inexact matches, list follows (...) [proto>=1] if ($self->code() == 210 or $self->code() == 211) { my $discs = $self->read_until_dot(); return unless defined $discs; my @matches; foreach my $disc (@$discs) { my ($genre, $cddbp_id, $title) = ($disc =~ /^(\S+)\s*(\S+)\s*(.*?)\s*$/); push(@matches, [ $genre, $cddbp_id, $title ]); } return @matches; } # What the heck? $self->debug_print( 0, "--- unknown cddbp response: ", $self->code(), ' ', $self->text() ); return; } #------------------------------------------------------------------------------ # A little helper to combine list-context calculate_id() with # get_discs(). sub get_discs_by_toc { my $self = shift; my (@info, @discs); if (@info = $self->calculate_id(@_)) { @discs = $self->get_discs(@info[0, 3, 4]); } @discs; } #------------------------------------------------------------------------------ # A little helper to get discs from an existing query string. # Contributed by Ron Grabowski. sub get_discs_by_query { my ($self, $query) = @_; my (undef, undef, $cddbp_id, $tracks, @offsets) = split /\s+/, $query; my $total_seconds = pop @offsets; my @discs = $self->get_discs($cddbp_id, \@offsets, $total_seconds); return @discs; } #------------------------------------------------------------------------------ # Retrieve the database record for a particular genre/id combination. # Returns a moderately complex hashref representing the cddbp record, # or undef on failure. sub get_disc_details { my $self = shift; my ($genre, $id) = @_; # Because cddbp only allows one detail query per connection, we # force a disconnect/reconnect here if we already did one. if (exists $self->{'got tracks before'}) { $self->disconnect(); $self->connect() or return; } $self->{'got tracks before'} = 'yes'; $self->command('cddb read', $genre, $id); my $code = $self->response(); if ($code != 2) { $self->debug_print( 0, "--- cddbp host could not read the disc record: ", $self->code(), ' ', $self->text() ); return; } my $track_file; unless (defined($track_file = $self->read_until_dot())) { $self->debug_print( 0, "--- cddbp disc record interrupted" ); return; } # Parse that puppy. return parse_xmcd_file($track_file, $genre); } # Arf! sub parse_xmcd_file { my ($track_file, $genre) = @_; my %details = ( offsets => [ ], seconds => [ ], ); my $state = 'beginning'; foreach my $line (@$track_file) { # Keep returned so-called xmcd record... $details{xmcd_record} .= $line . "\n"; if ($state eq 'beginning') { if ($line =~ /track\s*frame\s*off/i) { $state = 'offsets'; } next; } if ($state eq 'offsets') { if ($line =~ /^\#\s*(\d+)/) { push @{$details{offsets}}, $1; next; } $state = 'headers'; # This passes through on purpose. } # This is not an elsif on purpose. if ($state eq 'headers') { if ($line =~ /^\#/) { $line =~ s/\s+/ /g; if (my ($header, $value) = ($line =~ /^\#\s*(.*?)\:\s*(.*?)\s*$/)) { $details{lc($header)} = $value; } next; } $state = 'data'; # This passes through on purpose. } # This is not an elsif on purpose. if ($state eq 'data') { next unless ( my ($tag, $idx, $val) = ($line =~ /^\s*(.+?)(\d*)\s*\=\s*(.+?)\s*$/) ); $tag = lc($tag); if ($idx ne '') { $tag .= 's'; $details{$tag} = [ ] unless exists $details{$tag}; $details{$tag}->[$idx] .= $val; $details{$tag}->[$idx] =~ s/^\s+//; $details{$tag}->[$idx] =~ s/\s+$//; $details{$tag}->[$idx] =~ s/\s+/ /g; } else { $details{$tag} .= $val; $details{$tag} =~ s/^\s+//; $details{$tag} =~ s/\s+$//; $details{$tag} =~ s/\s+/ /g; } } } # Translate disc offsets into seconds. This builds a virtual track # 0, which is the time from the beginning of the disc to the # beginning of the first song. That time's used later to calculate # the final track's length. my $last_offset = 0; foreach (@{$details{offsets}}) { push @{$details{seconds}}, int(($_ - $last_offset) / 75); $last_offset = $_; } # Create the final track length from the disc length. Remove the # virtual track 0 in the process. my $disc_length = $details{"disc length"}; $disc_length =~ s/ .*$//; my $first_start = shift @{$details{seconds}}; push( @{$details{seconds}}, $disc_length - int($details{offsets}->[-1] / 75) + 1 - $first_start ); # Add the genre, if we have it. $details{genre} = $genre; return \%details; } ############################################################################### # Evil voodoo e-mail submission stuff. #------------------------------------------------------------------------------ # Return true/false whether the libraries needed to submit discs are # present. sub can_submit_disc { my $self = shift; $imported_mail; } #------------------------------------------------------------------------------ # Build an e-mail address, and return it. Caches the last built # address, and returns that on subsequent calls. sub get_mail_address { my $self = shift; return $self->{mail_from} if defined $self->{mail_from}; return $self->{mail_from} = $self->{login} . '@' . $self->{hostname}; } #------------------------------------------------------------------------------ # Build an e-mail host, and return it. Caches the last built e-mail # host, and returns that on subsequent calls. sub get_mail_host { my $self = shift; return $self->{mail_host} if defined $self->{mail_host}; if (exists $ENV{SMTPHOSTS}) { $self->{mail_host} = $ENV{SMTPHOSTS}; } elsif (defined inet_aton('mail')) { $self->{mail_host} = 'mail'; } else { $self->{mail_host} = 'localhost'; } return $self->{mail_host}; } # Build a cddbp disc submission and try to e-mail it. sub submit_disc { my $self = shift; my %params = @_; croak( "submit_disc needs Mail::Internet, Mail::Header, and MIME::QuotedPrint" ) unless $imported_mail; # Try yet again to fetch the hostname. Fail if we cannot. unless (defined $self->{hostname}) { $self->{hostname} = &hostname() or croak "can't get hostname: $!"; } # Validate the required submission fields. XXX Duplicated code. (exists $params{Genre}) or croak "submit_disc needs a Genre"; (exists $params{Id}) or croak "submit_disc needs an Id"; (exists $params{Artist}) or croak "submit_disc needs an Artist"; (exists $params{DiscTitle}) or croak "submit_disc needs a DiscTitle"; (exists $params{TrackTitles}) or croak "submit_disc needs TrackTitles"; (exists $params{Offsets}) or croak "submit_disc needs Offsets"; (exists $params{Revision}) or croak "submit_disc needs a Revision"; if (exists $params{Year}) { unless ($params{Year} =~ /^\d{4}$/) { croak "submit_disc needs a 4 digit year"; } } if (exists $params{GenreLong}) { unless ($params{GenreLong} =~ /^([A-Z][a-zA-Z0-9]*\s?)+$/) { croak( "GenreLong must start with a capital letter and contain only " . "letters and numbers" ); } } # Try to find a mail host. We could probably grab the MX record for # the current machine, but that would require yet more strange # modules. TODO: Use Net::DNS if it's available (why not?) and just # bypass it if it isn't installed. $self->{mail_host} = $params{Host} if exists $params{Host}; my $host = $self->get_mail_host(); # Override the sender's e-mail address with whatever was specified # during the object's constructor call. $self->{mail_from} = $params{From} if exists $params{From}; my $from = $self->get_mail_address(); # Build the submission's headers. my $header = new Mail::Header; $header->add( 'MIME-Version' => '1.0' ); my $charset = $self->{'utf8'} ? 'utf-8' : 'iso-8859-1'; $header->add( 'Content-Type' => "text/plain; charset=$charset" ); $header->add( 'Content-Disposition' => 'inline' ); $header->add( 'Content-Transfer-Encoding' => 'quoted-printable' ); $header->add( From => $from ); $header->add( To => $self->{cddbmail} ); # send a copy to ourselves if we are debugging $header->add( Cc => $from ) if $self->{debug}; $header->add( Subject => "cddb $params{Genre} $params{Id}" ); # Build the submission's body. my @message_body = ( '# xmcd', '#', '# Track frame offsets:', map({ "#\t" . $_; } @{$params{Offsets}}), '#', '# Disc length: ' . (hex(substr($params{Id},2,4))+2) . ' seconds', '#', "# Revision: " . $params{Revision}, '# Submitted via: ' . $self->{libname} . ' ' . $self->{libver}, '#', 'DISCID=' . $params{Id}, 'DTITLE=' . $params{Artist} . ' / ' . $params{DiscTitle}, ); # add year and genre if (exists $params{Year}) { push @message_body, 'DYEAR='.$params{Year}; } if (exists $params{GenreLong}) { push @message_body, 'DGENRE='.$params{GenreLong}; } # Dump the track titles. my $number = 0; foreach my $title (@{$params{TrackTitles}}) { my $copy = $title; while ($copy ne '') { push( @message_body, 'TTITLE' . $number . '=' . substr($copy, 0, 69)); substr($copy, 0, 69) = ''; } $number++; } # Dump extended information. push @message_body, 'EXTD='; push @message_body, map { "EXTT$_="; } (0..--$number); push @message_body, 'PLAYORDER='; # Translate the message body to quoted printable. TODO: How can I # ensure that the quoted printable characters are within ISO-8859-1? # The cddbp submissions daemon will barf if it's not. foreach my $line (@message_body) { $line .= "\n"; $line = MIME::QuotedPrint::encode_qp(encode('utf8', $line)); } # Bundle the headers and body into an Internet mail. my $mail = new Mail::Internet( undef, Header => $header, Body => \@message_body, ); # Try to send it using the "mail" utility. This is commented out: # it strips the MIME headers from the message, invalidating the # submission. #eval { # die unless $mail->send( 'mail' ); #}; #return 1 unless $@; # Try to send it using "sendmail". eval { die unless $mail->send( 'sendmail' ); }; return 1 unless $@; # Try to send it by making a direct SMTP connection. eval { die unless $mail->send( smtp => Server => $host ); }; return 1 unless $@; # Augh! Everything failed! $self->debug_print( 0, '--- could not find a way to submit a disc' ); return; } 1; __END__ =head1 NAME CDDB.pm - a high-level interface to cddb protocol servers (freedb and CDDB) =head1 VERSION version 1.222 =head1 SYNOPSIS use CDDB; ### Connect to the cddbp server. my $cddbp = new CDDB( Host => 'freedb.freedb.org', # default Port => 8880, # default Login => $login_id, # defaults to %ENV's ) or die $!; ### Retrieve known genres. my @genres = $cddbp->get_genres(); ### Calculate cddbp ID based on MSF info. my @toc = ( '1 0 2 37', # track, CD-i MSF (space-delimited) '999 1 38 17', # lead-out track MSF '1000 0 0 Error!', # error track (don't include if ok) ); my ( $cddbp_id, # used for further cddbp queries $track_numbers, # padded with 0's (for convenience) $track_lengths, # length of each track, in MM:SS format $track_offsets, # absolute offsets (used for further cddbp queries) $total_seconds # total play time, in seconds (for cddbp queries) ) = $cddbp->calculate_id(@toc); ### Query discs based on cddbp ID and other information. my @discs = $cddbp->get_discs($cddbp_id, $track_offsets, $total_seconds); foreach my $disc (@discs) { my ($genre, $cddbp_id, $title) = @$disc; } ### Query disc details (usually done with get_discs() information). my $disc_info = $cddbp->get_disc_details($genre, $cddbp_id); my $disc_time = $disc_info->{'disc length'}; my $disc_id = $disc_info->{discid}; my $disc_title = $disc_info->{dtitle}; my @track_offsets = @{$disc_info->{offsets}}; my @track_seconds = @{$disc_info->{seconds}}; my @track_titles = @{$disc_info->{ttitles}}; # other information may be returned... explore! ### Submit a disc via e-mail. (Requires MailTools) die "can't submit a disc (no mail modules; see README)" unless $cddbp->can_submit_disc(); # These are useful for prompting the user to fix defaults: print "I will send mail through: ", $cddbp->get_mail_host(), "\n"; print "I assume your e-mail address is: ", $cddbp->get_mail_address(), "\n"; # Actually submit a disc record. $cddbp->submit_disc( Genre => 'classical', Id => 'b811a20c', Artist => 'Various', DiscTitle => 'Cartoon Classics', Offsets => $disc_info->{offsets}, # array reference TrackTitles => $disc_info->{ttitles}, # array reference From => 'login@host.domain.etc', # will try to determine ); =head1 DESCRIPTION CDDB protocol (cddbp) servers provide compact disc information for programs that need it. This allows such programs to display disc and track titles automatically, and it provides extended information like liner notes and lyrics. This module provides a high-level Perl interface to cddbp servers. With it, a Perl program can identify and possibly gather details about a CD based on its "table of contents" (the disc's track times and offsets). Disc details have been useful for generating CD catalogs, naming mp3 files, printing CD liners, or even just playing discs in an automated jukebox. Despite the module's name, it connects to FreeDB servers by default. This began at version 1.04, when cddb.com changed its licensing model to support end-user applications, not third-party libraries. Connections to cddb.com may still work, and patches are welcome to maintain that functionality, but it's no longer officially supported. =head1 PUBLIC METHODS =over 4 =item new PARAMETERS Creates a high-level interface to a cddbp server, returning a handle to it. The handle is not a filehandle. It is an object. The new() constructor provides defaults for just about everything, but everything is overrideable if the defaults aren't appropriate. The interface will not actually connect to a cddbp server until it's used, and a single cddbp interface may actually make several connections (to possibly several servers) over the course of its use. The new() constructor accepts several parameters, all of which have reasonable defaults. B and B describe the cddbp server to connect to. These default to 'freedb.freedb.org' and 8880, which is a multiplexor for all the other freedb servers. B is a boolean flag. If true, utf-8 will be used when submitting CD info, and for interpreting the data reveived. This requires the L module (and probably perl version at least 5.8.0). The default is true if the L module can be loaded. Otherwise, it will be false, meaning we fall back to ASCII. B sets the cddbp version to use. CDDB.pm will not connect to servers that don't support the version specified here. The requested protocol version defaults to 1 if B is off, and to 6 if it is on. B is the login ID you want to advertise to the cddbp server. It defaults to the login ID your computer assigns you, if that can be determined. The default login ID is determined by the presence of a LOGNAME or USER environment variable, or by the getpwuid() function. On Windows systems, it defaults to "win32usr" if no default method can be found and no Login parameter is set. B is the e-mail address where new disc submissions go. This defaults to 'freedb-submit@freedb.org'. Note, that testing submissions should be done via C. B and B describe the client software used to connect to the cddbp server. They default to 'CDDB.pm' and CDDB.pm's version number. If developers change this, please consult freedb's web site for a list of client names already in use. B enables verbose operational information on STDERR when set to true. It's normally not needed, but it can help explain why a program is failing. If someone finds a reproduceable bug, the Debug output and a test program would be a big help towards having it fixed. In case of submission, if this flag is on, a copy of the submission e-mail will be sent to the I address. =item get_genres Takes no parameters. Returns a list of genres known by the cddbp server, or undef if there is a problem retrieving them. =item calculate_id TOC The cddb protocol defines an ID as a hash of track lengths and the number of tracks, with an added checksum. The most basic information required to calculate this is the CD table of contents (the CD-i track offsets, in "MSF" [Minutes, Seconds, Frames] format). Note however that there is no standard way to acquire this information from a CD-ROM device. Therefore this module does not try to read the TOC itself. Instead, developers must combine CDDB.pm with a CD library which works with their system. The AudioCD suite of modules is recommended: it has system specific code for MacOS, Linux and FreeBSD. CDDB.pm's author has used external programs like dagrab to fetch the offsets. Actual CDs aren't always necessary: the author has heard of people generating TOC information from mp3 file lengths. That said, see parse_cdinfo() for a routine to parse "cdinfo" output into a table of contents list suitable for calculate_id(). calculate_id() accepts TOC information as a list of strings. Each string contains four fields, separated by whitespace: offset 0: the track number Track numbers start with 1 and run sequentially through the number of tracks on a disc. Note: data tracks count on hybrid audio/data CDs. CDDB.pm understands two special track numbers. Track 999 holds the lead-out information, which is required by the cddb protocol. Track 1000 holds information about errors which have occurred while physically reading the disc. offset 1: the track start time, minutes field Tracks are often addressed on audio CDs using "MSF" offsets. This stands for Minutes, Seconds, and Frames (fractions of a second). The combination pinpoints the exact disc frame where a song starts. Field 1 contains the M part of MSF. It is ignored for error tracks, but it still must contain a number. Zero is suggested. offset 2: the track start time, seconds field This field contains the S part of MSF. It is ignored for error tracks, but it still must contain a number. Zero is suggested. offset 3: the track start time, frames field This field contains the F part of MSF. For error tracks, it contains a description of the error. Example track file. Note: the comments should not appear in the file. 1 0 2 37 # track 1 starts at 00:02 and 37 frames 2 1 38 17 # track 2 starts at 01:38 and 17 frames 3 11 57 30 # track 3 starts at 11:57 and 30 frames ... 999 75 16 5 # leadout starts at 75:16 and 5 frames Track 1000 should not be present if everything is okay: 1000 0 0 Error reading TOC: no disc in drive In scalar context, calculate_id() returns just the cddbp ID. In a list context, it returns an array containing the following values: ( $cddbp_id, $track_numbers, $track_lengths, $track_offsets, $total_seconds ) = $cddbp->calculate_id(@toc); print( "cddbp ID = $cddbp_id\n", # b811a20c "track numbers = @$track_numbers\n", # 001 002 003 ... "track lengths = @$track_lengths\n", # 01:36 10:19 04:29 ... "track offsets = @$track_offsets\n", # 187 7367 53805 ... "total seconds = $total_seconds\n", # 4514 ); CDDBP_ID The 0th returned value is the hashed cddbp ID, required for any queries or submissions involving this disc. TRACK_NUMBERS The 1st returned value is a reference to a list of track numbers, one for each track (excluding the lead-out), padded to three characters with leading zeroes. These values are provided for convenience, but they are not required by cddbp servers. TRACK_LENGTHS The 2nd returned value is a reference to a list of track lengths, one for each track (excluding the lead-out), in HH:MM format. These values are returned as a convenience. They are not required by cddbp servers. TRACK_OFFSETS The 3rd returned value is a reference to a list of absolute track offsets, in frames. They are calculated from the MSF values, and they are required by get_discs() and submit_disc(). TOTAL_SECONDS The 4th and final value is the total playing time for the CD, in seconds. The get_discs() function needs it. =item get_discs CDDBP_ID, TRACK_OFFSETS, TOTAL_SECONDS get_discs() asks the cddbp server for a summary of all the CDs matching a given cddbp ID, track offsets, and total playing time. These values can be retrieved from calculade_id(). my @id_info = $cddbp->calculate_id(@toc); my $cddbp_id = $id_info->[0]; my $track_offsets = $id_info->[3]; my $total_seconds = $id_info->[4]; get_discs() returns an array of matching discs, each of which is represented by an array reference. It returns an empty array if the query succeeded but did not match, and it returns undef on error. my @discs = $cddbp->get_discs( $cddbp_id, $track_offsets, $total_seconds ); foreach my $disc (@discs) { my ($disc_genre, $disc_id, $disc_title) = @$disc; print( "disc id = $disc_id\n", "disc genre = $disc_genre\n", "disc title = $disc_title\n", ); } DISC_GENRE is the genre this disc falls into, as determined by whoever submitted or last edited the disc. The genre is required when requesting a disc's details. See get_genres() for how to retrieve a list of cddbp genres. CDDBP_ID is the cddbp ID of this disc. Cddbp servers perform fuzzy matches, returning near misses as well as direct hits on a cddbp ID, so knowing the exact ID for a disc is important when submitting changes or requesting a particular near-miss' details. DISC_TITLE is the disc's title, which may help a human to pick the correct disc out of several close mathches. =item get_discs_by_toc TOC This function acts as a macro, combining calculate_id() and get_discs() calls into one function. It takes the same parameters as calculate_id(), and it returns the same information as get_discs(). =item get_discs_by_query QUERY_STRING Fetch discs by a pre-built cddbp query string. Some disc querying programs report this string, and get_discs_by_query() is a convenient way to use that. Cddb protocol query strings look like: cddb query $cddbp_id $track_count @offsets $total_seconds =item get_disc_details DISC_GENRE, CDDBP_ID This function fetches a disc's detailed information from a cddbp server. It takes two parameters: the DISC_GENRE and the CDDP_ID. These parameters usually come from a call to get_discs(). The disc's details are returned in a reference to a fairly complex hash. It includes information normally stored in comments. The most common entries in this hash include: $disc_details = get_disc_details( $disc_genre, $cddbp_id ); $disc_details->{"disc length"} The disc length is commonly stored in the form "### seconds", where ### is the disc's total playing time in seconds. It may hold other time formats. $disc_details->{discid} This is a rehash (get it?) of the cddbp ID. It should match the CDDBP_ID given to get_disc_details(). $disc_details->{dtitle} This is the disc's title. I do not know whether it will match the one returned by get_discs(). $disc_details->{offsets} This is a reference to a list of absolute disc track offsets, similar to the TRACK_OFFSETS returned by calculate_id(). $disc_details->{seconds} This is a reference to a list of track length, in seconds. $disc_details->{ttitles} This is a reference to a list of track titles. These are the droids you are looking for. $disc_details->{"processed by"} This is a comment field identifying the name and version of the cddbp server which accepted and entered the disc record into the database. $disc_details->{revision} This is the disc record's version number, used as a sanity check (semaphore?) to prevent simultaneous revisions. Revisions start at 0 for new submissions and are incremented for every correction. It is the responsibility of the submitter (be it a person or a program using CDDB.pm) to provide a correct revision number. $disc_details->{"submitted via"} This is the name and version of the software that submitted this cddbp record. The main intention is to identify records that are submitted by broken software so they can be purged or corrected. $disc_details->{xmcd_record} The xmcd_record field contains a copy of the entire unprocessed cddbp response that generated all the other fields. $disc_details->{genre} This is merely a copy of DISC_GENRE, since it's otherwise not possible to determine it from the hash. =item parse_xmcd_file XMCD_FILE_CONTENTS, [GENRE] Parses an array ref of lines read from an XMCD file into the disc_details hash described above. If the GENRE parameter is set it will be included in disc_details. =item can_submit_disc Returns true or false, depending on whether CDDB.pm has enough dependent modules to submit discs. If it returns false, you are missing Mail::Internet, Mail::Header, or MIME::QuotedPrint. =item get_mail_address Returns what CDDB.pm thinks your e-mail address is, or what it was last set to. It was added to fetch the default e-mail address so users can see it and have an opportunity to correct it. my $mail_from = $cddb->get_mail_address(); print "New e-mail address (or blank to keep <$mail_from>): "; my $new_mail_from = ; $new_mail_from =~ s/^\s+//; $new_mail_from =~ s/\s+$//; $new_mail_from =~ s/\s+/ /g; $mail_from = $new_mail_from if length $new_mail_from; $cddbp->submit_disc( ..., From => $mail_from, ); =item get_mail_host Returns what CDDB.pm thinks your SMTP host is, or what it was last set to. It was added to fetch the default e-mail transfer host so users can see it and have an opportunity to correct it. my $mail_host = $cddb->get_mail_host(); print "New e-mail host (or blank to keep <$mail_host>): "; my $new_mail_host = ; $new_mail_host =~ s/^\s+//; $new_mail_host =~ s/\s+$//; $new_mail_host =~ s/\s+/ /g; $mail_host = $new_mail_host if length $new_mail_host; $cddbp->submit_disc( ..., Host => $mail_host, ); =item parse_cdinfo CDINFO_FILE Generates a table of contents suitable for calculate_id() based on the output of a program called "cdinfo". CDINFO_FILE may either be a text file, or it may be the cdinfo program itself. my @toc = parse_cdinfo("cdinfo.txt"); # read cdinfo.txt my @toc = parse_cdinfo("cdinfo|"); # run cdinfo directly The table of contents can be passed directly to calculate_id(). =item submit_disc DISC_DETAILS submit_disc() submits a disc record to a cddbp server. Currently it only uses e-mail, although it will try different ways to send that. It returns true or false depending on whether it was able to send the submission e-mail. The rest of CDDB.pm will work without the ability to submit discs. While cddbp submissions are relatively rare, most CD collections will have one or two discs not present in the system. Please submit new discs to the system: the amazing number of existing discs got there because others submitted them before you needed them. submit_disc() takes six required parameters and two optional ones. The parameters are named, like hash elements, and can appear in any order. Genre => DISC_GENRE This is the disc's genre. It must be one of the genres that the server knows. See get_genres(). Id => CDDBP_ID This is the cddbp ID that identifies the disc. It should come from calculate_id() if this is a new submission, or from get_disc_details() if this is a revision. Artist => DISC_ARTIST This is the disc's artist, a freeform text field describing the party responsible for the album. It will need to be entered from the disc's notes for new submissions, or it can come from get_disc_details() on subsequent revisions. DiscTitle => DISC_TITLE This is the disc's title, a freeform text field describing the album. It must be entered from the disc's notes for new submissions. It can come from get_disc_details() on subsequent revisions. Offsets => TRACK_OFFSETS This is a reference to an array of absolute track offsets, as provided by calculate_id(). TrackTitles => TRACK_TITLES This is a reference to an array of track titles, either entered by a human or provided by get_disc_details(). From => EMAIL_ADDRESS This is the disc submitter's e-mail address. It's not required, and CDDB.pm will try to figure one out on its own if an address is omitted. It may be more reliable to provide your own, however. The default return address may not be a deliverable one, especially if CDDB.pm is being used on a dial-up machine that isn't running its own MTA. If the current machine has its own MTA, problems still may occur if the machine's Internet address changes. Host => SMTP_HOST This is the SMTP host to contact when sending mail. It's not required, and CDDB.pm will try to figure one out on its own. It will look at the SMTPHOSTS environment variable is not defined, it will try 'mail' and 'localhost' before finally failing. Revision => REVISION The revision number. Should be 1 for new submissions, and one higher than the previous one for updates. The previous revision number is available as the C field in the hash returned by get_disc_details(). =back =head1 PRIVATE METHODS Documented as being not documented. =head1 EXAMPLES Please see the cddb.t program in the t (tests) directory. It exercises every aspect of CDDB.pm, including submissions. =head1 COMPATIBILITY CDDB.pm uses standard Perl modules. It has been tested at one point or another on OS/2, MacOS and FreeBSD systems, as well as the systems listed at: http://testers.cpan.org/search?request=dist&dist=CDDB If you want to submit disc information to the CDDB, you will need to install two other modules: Mail::Internet will allow CDDB.pm to send email submissions, and it automagically includes Mail::Header. MIME::QuotedPrint will allow CDDB.pm to send non-ASCII text unscathed. Currently only ISO-8859-1 and ASCII are supported. All other features will work without these modules. =head1 KNOWN TEST FAILURES The last test in the "make test" suite will try to send a sample submission to the CDDB if MailTools is present. It expects to find an SMTP host in the SMTPHOST environment variable. It will fall back to "mail" if SMTPHOST doesn't exist. If neither works, the test will be skipped. To see why it's skipped: make test TEST_VERBOSE=1 Some of the tests (most notably numbers 25, 27 and 29) compare data returned by a cddbp server against a stored copy of a previous query. These tests fail occasionally since the database is constantly in flux. Starting with version 1.00, the test program uses fuzzy comparisons that should fail less. Version 1.04 saw even fuzzier comparisons. Please report any problems so they can be fixed. =head1 LINKS =head2 BUG TRACKER https://rt.cpan.org/Dist/Display.html?Status=Active&Queue=CDDB =head2 REPOSITORY http://github.com/rcaputo/cddb-perl http://gitorious.org/cddb-freedb-perl =head2 OTHER RESOURCES http://search.cpan.org/dist/CDDB/ =head1 CONTACT AND COPYRIGHT Copyright 1998-2013 Rocco Caputo. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut # vim: sw=2 tw=70: CDDB-1.222/eg/osx-lookup.pl000644 000765 000024 00000001721 12203077571 015403 0ustar00trocstaff000000 000000 #!/usr/bin/env perl # Display the disc information for any mounted CDs on an OS X system. use warnings; use strict; use lib qw(./lib); use Mac::PropertyList qw(parse_plist_file); use CDDB; my $cddb = CDDB->new(); CD: foreach my $toc_name () { my $toc = parse_plist_file($toc_name); my @toc; foreach my $track (@{$toc->{'Sessions'}[0]{'Track Array'}}) { my $number = $track->{'Point'}->value(); my $block = $track->{'Start Block'}->value(); push @toc, "$number 0 0 $block"; } push @toc, '999 0 0 ' . $toc->{'Sessions'}[0]{'Leadout Block'}->value(); my @discs = $cddb->get_discs_by_toc(@toc); unless (@discs) { warn "$toc_name = no discs found"; next CD; } foreach my $disc (@discs) { my ($genre, $id, $title) = @$disc; my $disc_details = $cddb->get_disc_details($genre, $id); delete $disc_details->{xmcd_record}; # for display use YAML::Syck; print YAML::Syck::Dump($disc_details); } }