From: Michael Howe Date: Sun, 9 Mar 2014 00:25:49 +0000 (+0000) Subject: Import original source of Net-Google-Calendar 1.05 X-Git-Tag: upstream/1.05 X-Git-Url: https://git.michaelhowe.org/gitweb/?a=commitdiff_plain;h=12eb93e46fc9494096af8e63dee16dc64546bf62;p=packages%2Flibn%2Flibnet-google-calendar-perl.git Import original source of Net-Google-Calendar 1.05 --- 12eb93e46fc9494096af8e63dee16dc64546bf62 diff --git a/Changes b/Changes new file mode 100644 index 0000000..758f56e --- /dev/null +++ b/Changes @@ -0,0 +1,107 @@ + - Revision history for Perl module Net::Google::Calendar + +1.04 2013-09-14 + +1.03 2013-09-14 + +1.02 2013-09-14 + - Added method to get originalEvent from XML - suggested by Ian Norton + +1.01 2012-03-18 + - Fixed POD typo (Pete Lytle) + (https://rt.cpan.org/Ticket/Display.html?id=61798) + - Added "302 moved temporarily" patch (Pete Lytle) + (https://rt.cpan.org/Ticket/Display.html?id=69824) + +1.0 2010-07-19 + - Add OAuth support (Patrick Michaud) + - Add convenience methods to Calendar object (Patrick Michaud) + - Add reminder support to Net::Google::Calendar::Entry (Stanislav Anton) + (https://rt.cpan.org/Public/Bug/Display.html?id=40811) + - Add html_url method to ::Entry (Jerrad Pierce) + (https://rt.cpan.org/Ticket/Display.html?id=54354) + +0.99 2010-04-03 + - Make when return an all day flag (Tim Irvin) + +0.98 2010-04-03 + - Fix minimum XML::Atom version (Tim Irvin) + - Deal with ExtendedProperty properly (Tim Irvin) + - Add is_allday (Tim Irvin) + +0.97 2009-05-09 + - Deal with update to Net::Google::AuthSub + - Provide access to AuthSub object + - Add quick_add support for Entry + + [0.96 not released?] + - Much better when() behaviour (J. Shirley) + +0.95 2008-07-29 + - Fix typo in base (various) + - Allow proxies (Justin Hayes) + +0.94 2008-04-09 + - Fix distribution + - Fix when() call (J. Shirley) + +0.93 2008-04-08 + - Much better attendee support + - Fix typo (James Wright) + - Added start of comment support + +0.92 2007-12-19 + - Fix creation duplicate tags when editing an existing record + (James Wright) + - Fix fetching of a single entry using entryID (James Wright) + - Allow Google Gadgets and prefs in WebContent + +0.91 2007-12-16 + - Fix bad release + +0.9 2007-12-15 + - Fix location in Entry (Julian Bilcke) + - Add ability to create, update and delete calendars + - Add ability to get attendees (Scott Gifford) + - Fix bug with getting objects instead of scalars (Mark Allen) + - Use Net::Google::AuthSub + - Allow webcontent in Entries + +0.8 2007-04-16 + - Don't clobber the url passed in (Rich Williams) + - Allow setting of all-day events (Rich Williams) + +0.7 2007-04-02 + - Sort out problem with read-write feeds. + - Default to inplace overwriting of added and updated events. + +0.6 2007-03-18 + - Allow Authorization token login (advice from various people) + - Use the HOSTED_OR_GOOGLE app type by default (ditto) + +0.5 2006-11-01 + - Make when() work properly again, not sure what happened there + - Enable posting to non-default calendars + - Enable listing of all Calendars + - Allow reading of Calendar without logging in + (as long as you have the magic cookie) + +0.4 2006-10-01 + - Fix for changes in XML::Atom + - Fix for UTF8 receiving (Gosuke Miyashita) + +0.3 2006-08-31 + - Timezone support (HarleyPig) + - Other calendar support (HarleyPig) + - UTF8 posting support (Yi-Hsuan Hsin) + - Fix bug with namespacing support in Entry recasting (Yi-Hsuan Hsin) + +0.2 2006-06-15 + - Support for querying entries + - Support for recurring events + (thanks to Google *finally* fixing their service) + +0.1 2006-04-26 + - Initial release + - Support for listing entries then adding, deleting or updating them + diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..0aa47c8 --- /dev/null +++ b/LICENSE @@ -0,0 +1,379 @@ +This software is copyright (c) 2013 by Peter Lytle. + +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 Peter Lytle. + +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 Peter Lytle. + +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 + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..bb04b23 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,28 @@ +Changes +LICENSE +MANIFEST +META.yml +Makefile.PL +README +TODO +USAGE +bin/google-calendar +dist.ini +lib/Net/Google/Calendar.pm +lib/Net/Google/Calendar/Base.pm +lib/Net/Google/Calendar/Calendar.pm +lib/Net/Google/Calendar/Comments.pm +lib/Net/Google/Calendar/Entry.pm +lib/Net/Google/Calendar/FeedLink.pm +lib/Net/Google/Calendar/Person.pm +lib/Net/Google/Calendar/WebContent.pm +t/01use.t +t/02events.t +t/02events_base +t/03calendars.t +t/04attendees.t +t/05comments.t +t/TODO +t/lib/GCalTest.pm +t/pod-coverage.t +t/pod.t diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..3ce67ab --- /dev/null +++ b/META.yml @@ -0,0 +1,47 @@ +--- +abstract: 'Interface to Google calendars' +author: + - 'Peter Lytle ' +build_requires: + Test::More: 0 + lib: 0 + warnings: 0 +configure_requires: + ExtUtils::MakeMaker: 6.30 +dynamic_config: 0 +generated_by: 'Dist::Zilla version 4.300038, CPAN::Meta::Converter version 2.120921' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 +name: Net-Google-Calendar +requires: + Carp: 0 + Data::Dumper: 0 + Data::ICal: 0 + Data::ICal::Entry::Event: 0 + Date::ICal: 0 + DateTime: 0 + DateTime::Event::Recurrence: 0 + DateTime::Format::ICal: 0 + Encode: 0 + HTTP::Cookies: 0 + HTTP::Headers: 0 + HTTP::Request: 0 + HTTP::Request::Common: 0 + LWP::Simple: 0 + LWP::UserAgent: 0 + Net::Google::AuthSub: 0 + URI: 0 + URI::Escape: 0 + XML::Atom: 0 + XML::Atom::Entry: 0 + XML::Atom::Feed: 0 + XML::Atom::Link: 0 + XML::Atom::Person: 0 + XML::Atom::Thing: 0 + XML::Atom::Util: 0 + base: 0 + strict: 0 + vars: 0 +version: 1.05 diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..fd68e4f --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,98 @@ + +use strict; +use warnings; + + + +use ExtUtils::MakeMaker 6.30; + + + +my %WriteMakefileArgs = ( + "ABSTRACT" => "Interface to Google calendars", + "AUTHOR" => "Peter Lytle ", + "BUILD_REQUIRES" => {}, + "CONFIGURE_REQUIRES" => { + "ExtUtils::MakeMaker" => "6.30" + }, + "DISTNAME" => "Net-Google-Calendar", + "EXE_FILES" => [ + "bin/google-calendar" + ], + "LICENSE" => "perl", + "NAME" => "Net::Google::Calendar", + "PREREQ_PM" => { + "Carp" => 0, + "Data::Dumper" => 0, + "Data::ICal" => 0, + "Data::ICal::Entry::Event" => 0, + "Date::ICal" => 0, + "DateTime" => 0, + "DateTime::Event::Recurrence" => 0, + "DateTime::Format::ICal" => 0, + "Encode" => 0, + "HTTP::Cookies" => 0, + "HTTP::Headers" => 0, + "HTTP::Request" => 0, + "HTTP::Request::Common" => 0, + "LWP::Simple" => 0, + "LWP::UserAgent" => 0, + "Net::Google::AuthSub" => 0, + "URI" => 0, + "URI::Escape" => 0, + "XML::Atom" => 0, + "XML::Atom::Entry" => 0, + "XML::Atom::Feed" => 0, + "XML::Atom::Link" => 0, + "XML::Atom::Person" => 0, + "XML::Atom::Thing" => 0, + "XML::Atom::Util" => 0, + "base" => 0, + "strict" => 0, + "vars" => 0 + }, + "TEST_REQUIRES" => { + "Test::More" => 0, + "lib" => 0, + "warnings" => 0 + }, + "VERSION" => "1.05", + "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); + + + diff --git a/README b/README new file mode 100644 index 0000000..47a3cfc --- /dev/null +++ b/README @@ -0,0 +1,13 @@ + + +This archive contains the distribution Net-Google-Calendar, +version 1.05: + + Interface to Google calendars + +This software is copyright (c) 2013 by Peter Lytle. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + + diff --git a/TODO b/TODO new file mode 100644 index 0000000..a38b4be --- /dev/null +++ b/TODO @@ -0,0 +1,8 @@ +More complex locations +Comments +XHTML content +Support reading from and posting to other peoples calendars + + +Later, much later ... +Create Net::Google::Data and make ::Calendar a subclass of that? diff --git a/USAGE b/USAGE new file mode 100644 index 0000000..b40b79e --- /dev/null +++ b/USAGE @@ -0,0 +1,15 @@ +1. Get your feed url as described here + + http://code.google.com/apis/gdata/calendar.html#find_feed_url + + +2. Run + + perl -Ilib bin/google-calendar + +to list stuff and + + perl -Ilib bin/google-calendar + +to add an event. + diff --git a/bin/google-calendar b/bin/google-calendar new file mode 100644 index 0000000..b610c8e --- /dev/null +++ b/bin/google-calendar @@ -0,0 +1,209 @@ +#!perl -w + +## +# +# Please note that, for the time being, +# this is really just an example app +# +## + +use strict; +use Data::Dumper; +use Net::Google::Calendar; +use Net::Google::Calendar::Calendar; +use Net::Google::Calendar::WebContent; +use Data::ICal::Entry::Event; +use Date::ICal; + +my $url = shift || die "You must pass a feed url\n"; + + + + +#my $pe = Net::Google::Calendar::Person->new(); +#$pe->email('simon@thegestalt.org'); +#$pe->name('Simon Wistow'); + +#$e->who($pe); + +#my $pf = Net::Google::Calendar::Person->new(); +#$pf->email('rich@slag.org'); +#$pf->name('Richard Marr'); +#$e->who($pf, $pe); + +#print $e->as_xml; + +#exit 0; + + + + +#my %wc = ( +# url => 'http://thegestalt.org/simon/images/camouflage.png', +# width => '100', +# height => '80', +# type => 'image/png' +#); +#my $content = Net::Google::Calendar::WebContent->new( +# title => 'testing', +# href => 'http://thegestalt.org', +# webContent => \%wc +#); +#$content->webContent(%wc); +#$e->add_link($content); +#print $e->as_xml; + +my $content = Net::Google::Calendar::WebContent->new( + title => 'DateTime Gadget (a classic!)', + href => 'http://www.google.com/favicon.ico', + webContent => { + url => 'http://google.com/ig/modules/datetime.xml', + width => 300, + height => 136, + type => 'application/x-google-gadgets+xml', + prefs => { color => 'green' }, + } +); +#print $content->as_xml; +#$e->add_link($content); +#print $e->as_xml; + +#my $cal = Net::Google::Calendar->new( url => $url ); +my $cal = Net::Google::Calendar->new(); + +my $u = shift; +my $p = shift; +my $token = shift; + +$cal->login($u, $p) || die "Couldn't log in: $@\n"; +#$cal->auth($u, $token); + +#my $new_cal = Net::Google::Calendar::Calendar->new(); +#$new_cal->title("Testing New Calendar"); +#$new_cal->summary("A new calendar for testing"); +#print "**** Before ****\n".$new_cal->as_xml; +#my $cal_tmp = $cal->add_calendar($new_cal); +#if (defined $cal_tmp) { +# print "**** After ****\n".$cal_tmp->as_xml; +#} else { +# die "Couldn't add_calendar: $@\n"; +#} + +#$cal_tmp->title("Updating New Calendar"); +#$cal_tmp = $cal->update_calendar($cal_tmp) || die "Couldn't update calendar\n"; +#$cal_tmp->title =~ m!Updating! || die "Calendar not updated\n"; + +my $e = Net::Google::Calendar::Entry->new(); +$e->title("Title"); +$e->content("My content"); +my $d = DateTime->now->truncate( to => 'day' ); +#$e->when($d, $d, 1); +$e->when(DateTime->now, DateTime->now() + DateTime::Duration->new( hours => 48 ), 1); + + +#print $e->as_xml; +$cal->add_entry($e) || die "Couldn't add entry $@"; +print $e->as_xml; +exit 0; + +if (1 || (@ARGV && $ARGV[0] eq 'list')) { + for ($cal->get_calendars()) { + print $_->title."\n"; + print $_->id."\n\n"; + if ($_->title =~ /New Calendar/) { + $cal->delete_calendar($_, 1) || print "FAIL: $@\n"; + } + } + exit; +} + +my @calendars = $cal->get_calendars; +my ($c) = grep { $_->title =~ m!default!i } $cal->get_calendars; +#die "Couldn't get cal\n" unless defined $c; +$c = $calendars[0]; +$cal->set_calendar($c); + +if (!@ARGV) { + print "Getting events\n"; + for ($cal->get_events()) { + #print Dumper $_->as_xml; + #next; + print $_->title."\n"; + print $_->id."\n"; + my ($start, $finish) = $_->when(); + print "${start}-${finish}\n"; + #print $_->content->body; + print "\n*****\n\n"; + } + exit; +} + + +my $title = shift; + + +my $entry = Net::Google::Calendar::Entry->new(); +$entry->title($title); +$entry->content("My content"); +#$entry->location('London, England'); +#$entry->transparency('transparent'); +#$entry->status('confirmed'); +$entry->when(DateTime->now, DateTime->now() + DateTime::Duration->new( hours => 6 ) ); + +#my $author = Net::Google::Calendar::Person->new(); +#$author->name('Foo Bar'); +#$author->email('foo@bar.com'); +#$entry->author($author); + +my $recurrence = Data::ICal::Entry::Event->new(); + +use DateTime::Event::Recurrence; +use Date::ICal; +use DateTime::Format::ICal; + +my $last_day_of_the_month = DateTime::Event::Recurrence->monthly( days => -1 ); +$recurrence->add_properties( + dtstart => DateTime::Format::ICal->format_datetime(DateTime->now), + rrule => DateTime::Format::ICal->format_recurrence($last_day_of_the_month), +); + +#$entry->recurrence($recurrence); + +#print STDERR $entry->as_xml."\n\n\n*********************\n\n"; +#exit; + +print "Before=".scalar($cal->get_events())."\n"; + +$cal->add_entry($entry); +die "Couldn't add event: $@\n" unless defined $entry; + +print "After=".scalar($cal->get_events())."\n"; + +#die $entry->as_xml; + +$entry->content('Updated'); + +#print "Update\n"; +#$tmp = $cal->update_entry($tmp) || die "Couldn't update ".$tmp->id.": $@\n"; +$cal->update_entry($entry) || die "Couldn't update ".$entry->id.": $@\n"; +print "Updated=".scalar($cal->get_events())."\n"; + +#print $tmp->as_xml; + + + +for ($cal->get_events()) { +# print $_->title."\n"; +# print $_->id."\n"; +# my ($start, $finish) = $_->when(); +# print "${start}-${finish}\n"; +# #print $_->content->body; +# print "\n*****\n\n"; + $cal->delete_entry($_); +# # print $_->as_xml; +} + +print "Delete\n"; +#$cal->delete_entry($entry) || die "Couldn't delete ".$entry->id.": $@\n"; +print "Delete=".scalar($cal->get_events())."\n"; + diff --git a/dist.ini b/dist.ini new file mode 100644 index 0000000..7f96e16 --- /dev/null +++ b/dist.ini @@ -0,0 +1,12 @@ +name = Net-Google-Calendar +author = Peter Lytle <pete@bluecampaigns.com> +license = Perl_5 +copyright_holder = Peter Lytle +copyright_year = 2013 + +version = 1.05 + +[@Basic] +[PkgVersion] +[AutoPrereqs] +[Prereqs / TestRequires] diff --git a/lib/Net/Google/Calendar.pm b/lib/Net/Google/Calendar.pm new file mode 100644 index 0000000..54f4b8b --- /dev/null +++ b/lib/Net/Google/Calendar.pm @@ -0,0 +1,849 @@ +package Net::Google::Calendar; +{ + $Net::Google::Calendar::VERSION = '1.05'; +} + +use strict; +use LWP::UserAgent; +use HTTP::Cookies; +use HTTP::Request; +use HTTP::Headers; +use HTTP::Request::Common; +use XML::Atom::Feed; +use XML::Atom::Entry; +use Data::Dumper; +use Net::Google::AuthSub; +use Net::Google::Calendar::Entry; +use Net::Google::Calendar::Person; +use Net::Google::Calendar::Calendar; +use URI; +use URI::Escape; +use Carp qw(confess); + +use vars qw($VERSION $APP_NAME $REDIRECT_MAX); + +$APP_NAME = $Net::Google::OAuth::APP_NAME = __PACKAGE__."-${VERSION}"; + +$REDIRECT_MAX = 10; #Maximum number of redirects to allow + +# ABSTRACT: Interface to Google calendars + +=head1 NAME + +Net::Google::Calendar - programmatic access to Google's Calendar API + + +=head1 SYNOPSIS + + # this will only get you a read only feed + my $cal = Net::Google::Calendar->new( url => $private_url ); + +or + + # this will get you a read-write feed. + my $cal = Net::Google::Calendar->new; + $cal->login($username, $password); + +or + + # this will also get you a read-write feed + my $cal = Net::Google::Calendar->new; + $cal->auth($username, $auth_token); + +or + # this will again get you a read-write feed + my $cal = Net::Google::Calendar->new; + $cal->oauth(Net::Google::OAuth); + +or you can pass in a url to specify a particular calendar + + my $cal = Net::Google::Calendar->new( url => $non_default_url ); + $cal->login($username, $password); + # or $cal->auth($username, $auth_token) obviously + + +then + + for ($cal->get_events()) { + print $_->title."\n"; + print $_->content->body."\n*****\n\n"; + } + + my $c; + for ($cal->get_calendars) { + print $_->title."\n"; + print $_->id."\n\n"; + $c = $_ if ($_->title eq 'My Non Default Calendar'); + } + $cal->set_calendar($c); + print $cal->id." has ".scalar($cal->get_events)." events\n"; + + + # everything below here requires a read-write feed + my $entry = Net::Google::Calendar::Entry->new(); + $entry->title($title); + $entry->content("My content"); + $entry->location('London, England'); + $entry->transparency('transparent'); + $entry->status('confirmed'); + $entry->when(DateTime->now, DateTime->now() + DateTime::Duration->new( hours => 6 ) ); + + + my $author = Net::Google::Calendar::Person->new(); + $author->name('Foo Bar'); + $author->email('foo@bar.com'); + $entry->author($author); + +By default new or updated entries are modified in place with +any new information provided by Google. + + $cal->add_entry($entry); + + $entry->content('Updated'); + $cal->update_entry($entry); + + $cal->delete_entry($entry); + +However if you don't want the entry updated in place pass +C<no_event_modification> in to the C<new()> method. + + my $cal = Net::Google::Calendar->new( no_event_modification => 1 ); + $cal->login($user, $pass); + + my $tmp = $cal->add_entry($entry); + die "Couldn't add event: $@\n" unless defined $tmp; + + print "Events=".scalar($cal->get_events())."\n"; + + $tmp->content('Updated'); + + $tmp = $cal->update_entry($tmp) || die "Couldn't update ".$tmp->id.": $@\n"; + + $cal->delete_entry($tmp) || die "Couldn't delete ".$tmp->id.": $@\n"; + + + +=head1 DESCRIPTION + +Interact with Google's new calendar using the GData API. + + +=head1 AUTHENTICATION AND READ-WRITE CALENDARS + +There are effectively four ways to get events from a Google calendar. + +You can get any public events by querying + + http://www.google.com/calendar/feeds/<email>/public/full + +Then there are the three ways to get private entries. The first of these +involves a magic cookie in the url like this: + + http://www.google.com/calendar/feeds/<email>/private-<key>/full + +Google has information on how to find this url here + + http://code.google.com/apis/calendar/developers_guide_protocol.html#find_feed_url + +To use either the private or public feeds do + + my $cal = Net::Google::Calendar->new( url => $url); + +Both these feeds will be read only however. This means that you won't be able to +add, update or delete entries. + +You can also get all the private entries in a read-write feed by either logging in +or using C<AuthSub>. + +Logging in is the easiest. Simply do + + my $cal = Net::Google::Calendar->new; + $cal->login($username, $password); + +Where C<$username> and C<$password> are the same as if you were logging into the +Google Calendar site. + +Alternatively if you don't want to use username and password (if, for example you were +providing Calendar reading as a service on your website and didn't want to have to ask +your users for their Google login details) you can use C<AuthSub>. + + http://code.google.com/apis/accounts/AuthForWebApps.html + +Once you have an AuthSub token (or you user has supplied you with one) +then you can login using + + my $cal = Net::Google::Calendar->new; + $cal->auth($username, $token); + +=head1 METHODS + +=cut + +=head2 new <opts> + +Create a new instance. C<opts> is a hash which must contain your private Google url +as the key C<url> unless you plan to log in or authenticate. + +See + + http://code.google.com/apis/gdata/calendar.html#find_feed_url + +for how to get that. + +If you pass the option C<no_event_modification> as a psotive value then +add_entry and update_entry will not modify the entry in place. + +=cut + +sub new { + my ($class, %opts) = @_; + $opts{_ua} = LWP::UserAgent->new( max_redirect => 0 ); + $opts{_ua}->env_proxy; + $opts{_auth} = Net::Google::AuthSub->new( service => 'cl' ); + $opts{_cookie_jar} = HTTP::Cookies->new; + $opts{no_event_modification} ||= 0; + my $self = bless \%opts, $class; + $self->_find_calendar_id if $opts{url}; + return $self; +} + + +=head2 login <username> <password> [opt[s]] + +Login to google. + +Can optionally take a hash of options which will override the +default login params. + +=over 4 + +=item service + +Name of the Google service for which authorization is requested. + +Defaults to 'cl' for calendar. + +=item source + +Short string identifying your application, for logging purposes. + +Defaults to 'Net::Google::Calendar-<VERSION>' + +=item accountType + +Type of account to be authenticated. + +Defaults to 'HOSTED_OR_GOOGLE'. + +=back + +See http://code.google.com/apis/accounts/AuthForInstalledApps.html#ClientLogin for more details. + +=cut + +sub login { + my $self = shift; + my $user = shift; + my $pass = shift; + my $r = $self->{_auth}->login($user, $pass); + my $error; + if (!defined $r) { + $error = $@; + } elsif (!$r->is_success) { + $error = $r->error; + } + die "Couldn't log in - $error" if defined $error; + + $self->{user} = $user; + $self->_generate_url(); + return 1; +} + + +=head2 auth <username> <token> + +Use the AuthSub method for calendar access. +See http://code.google.com/apis/accounts/AuthForWebApps.html +for details. + + +=cut + +sub auth { + my $self = shift; + my $user = shift; + my $token = shift; + $self->{_auth}->auth($user, $token); + $self->{user} = $user; + $self->_generate_url(); + return 1; +} + +=head2 oauth Net::Google::OAuth + +Use OAuth for calendar access + +=cut + +sub oauth { + my $self = shift; + $self->{_auth} = shift; +} + +sub _generate_url { + my $self= shift; + $self->{url} ||= $self->_get_protocol()."://google.com/calendar/feeds/$self->{user}/private/full"; + $self->{url} =~ s!/private-[^/]+!/private!; + $self->_find_calendar_id; + +} + +=head2 auth_object [Net::Google::AuthSub] + +Get or set the current C<Net::Google::AuthSub> object. + +=cut +sub auth_object { + my $self = shift; + $self->{_auth} = shift if @_; + return $self->{_auth}; +} + +sub _find_calendar_id { + my $self = shift; + ($self->{calendar_id}) = ($self->{url} =~ m!/feeds/([^/]+)/!); +} + +=head2 ssl bool + +Use ssl or not. Auth tokens (AuthSub and OAuth) have a scope that includes http:// or https://. Make sure you use ssl(1) if your scope is https://www.google.com/calendar/feeds/. + +=cut + +sub ssl { + my $self = shift; + $self->{_use_ssl} = shift; +} + +sub _get_protocol { + my $self = shift; + if ($self->{_use_ssl}) { + return 'https'; + } + return 'http'; +} + +=head2 get_events [ %opts ] + +Return a list of Net::Google::Calendar::Entry objects; + +You can pass in a hash of options which map to the Google Data API's generic +searching mechanisms plus the specific calendar ones. + +See + + http://code.google.com/apis/gdata/protocol.html#query-requests + +for more details. + + +=over 4 + +=item q + +Full-text query string + +When creating a query, list search terms separated by spaces, in the +form q=term1 term2 term3. (As with all of the query parameter values, +the spaces must be URL encoded.) The GData service returns all entries +that match all of the search terms (like using AND between terms). Like +Google's web search, a GData service searches on complete words (and +related words with the same stem), not substrings. + +To search for an exact phrase, enclose the phrase in quotation marks: + + q => '"exact phrase' + +To exclude entries that match a given term, use the form + + q => '-term' + +The search is case-insensitive. + +Example: to search for all entries that contain the exact phrase +'Elizabeth Bennet' and the word 'Darcy' but don't contain the word +'Austen', use the following query: + + q => '"Elizabeth Bennet" Darcy -Austen' + + +=item category + +Category filter + +To search in just one category do + + category => 'Fritz' + +You can query on multiple categories by listing multiple category parameters. For example + + category => [ 'Fritz', 'Laurie' ] + +returns entries that match both categories. + + +To do an OR between terms, use a pipe character (|). For example + + + category => 'Fritz|Laurie' + +returns entries that match either category. + +To exclude entries that match a given category, use the form + + category => '-categoryname' + +You can, of course, mix and match + + [ 'Jo', 'Fritz|Laurie', '-Simon' ] + +means in category + + (Jo AND ( Fritz OR Laurie ) AND (NOT Simon)) + + +=item author + +Entry author + +The service returns entries where the author name and/or email address +match your query string. + +=item updated-min + +=item updated-max + +Bounds on the entry publication date. + +Use DateTime objects or the RFC 3339 timestamp format. For example: +2005-08-09T10:57:00-08:00. + +The lower bound is inclusive, whereas the upper bound is exclusive. + +=item start-min + +=item start-max + +Respectively, the earliest event start time to match (If not specified, +default is 1970-01-01) and the latest event start time to match (If +not specified, default is 2031-01-01). + +Use DateTime objects or the RFC 3339 timestamp format. For example: +2005-08-09T10:57:00-08:00. + +The lower bound is inclusive, whereas the upper bound is exclusive. + +=item start-index + +1-based index of the first result to be retrieved + +Note that this isn't a general cursoring mechanism. If you first send a +query with + + start-index => 1, + max-results => 10 + +and then send another query with + + start-index => 11, + max-results => 10 + +the service cannot guarantee that the results are equivalent to + + start-index => 1 + max-results => 20 + +because insertions and deletions could have taken place in between the +two queries. + +=item max-results + +Maximum number of results to be retrieved. + +For any service that has a default max-results value (to limit default +feed size), you can specify a very large number if you want to receive +the entire feed. + +=item entryID + +ID of a specific entry to be retrieved. + +If you specify an entry ID, you can't specify any other parameters. + +=back + +=cut + +sub get_events { + my ($self, %opts) = @_; + + + # check for DateTime objects and convert them to RFC 3339 + for (keys %opts) { + next unless UNIVERSAL::isa($opts{$_}, 'DateTime'); + # maybe we should chuck an error if it's a Ref and *not* a DateTime + #next unless $opts{$_}->isa('DateTime'); + $opts{$_} = $opts{$_}->iso8601 . 'Z'; + } + + my $url = URI->new($self->{url}); + + # special handling for single entryID lookup + if (exists $opts{entryID}) { + if (scalar(keys %opts)>1) { + $@ = "You can't specify entryID and anything else"; + return undef; + } + my $path = $url->path; + $url->path("$path/".$opts{entryID}); + return $self->_get_entry("$url", "Net::Google::Calendar::Entry"); + } + + if (exists $opts{category} && 'ARRAY' eq ref($opts{category})) { + my $path = $url->path."/".join("/", ( '-', @{delete $opts{category}})); + $url->path("$path"); + } + + $url->query_form(%opts); + $self->_get("$url", "Net::Google::Calendar::Entry"); +} + + +=head2 add_entry <Net::Google::Calendar::Entry> + +Create a new entry. + +Returns the new entry with extra data provided by Google but will +also modify the entry in place unless the C<no_event_modification> +option is passed to C<new()>. + +Returns undef on failure. + +=cut + +sub add_entry { + my ($self, $entry) = @_; + + # TODO for neatness' sake we could make calendar_id = 'default' when calendar_id = user + my $url = $self->_get_protocol()."://www.google.com/calendar/feeds/$self->{calendar_id}/private/full"; + push @_, ($url, 'POST'); + goto $self->can('_do'); +} + + +=head2 delete_entry <Net::Google::Calendar::Entry> + +Delete a given entry. + +Returns undef on failure or the old entry on success. + +=cut + +sub delete_entry { + my ($self, $entry) = @_; + my $force = (scalar(@_)>2)? pop @_ : 0; + my $url = $entry->edit_url($force) || return undef; + push @_, ($url, 'DELETE'); + goto $self->can('_do'); +} + +=head2 update_entry <Net::Google::Calendar::Entry> + +Update a given entry. + +Returns the updated entry with extra data provided by Google but will +also modify the entry in place unless the C<no_event_modification> +option is passed to C<new()>. + +Returns undef on failure. + +=cut + +sub update_entry { + my ($self, $entry) = @_; + my $url = $entry->edit_url || return undef; + push @_, ($url, 'PUT'); + goto $self->can('_do'); +} + +=head2 get_calendars <owned> + +Get a list of all of a user's Calendars as C<Net::Google::Calendar::Calendar> objects. + +If C<owned> is true then only get the ones a user owns. + +=cut + +sub get_calendars { + my $self = shift; + my $owned = shift || 0; + my $which = ($owned)? "owncalendars" : "allcalendars"; + my $url = $self->_get_protocol()."://www.google.com/calendar/feeds/default/$which/full"; + return $self->_get("$url", "Net::Google::Calendar::Calendar"); +} + + +sub _get { + my ($self, $url, $class, %opts) = @_; + my $feed = $self->get_feed(URI->new("$url"), %opts); + return map { bless $_, $class; $_->_initialize(); $_ } $feed->entries; +} + +=head2 get_feed [feed] [opt[s]] + +If C<feed> is a C<URI> object then feed is fetch remotely. +Otherwise it is assumed to be XML data and is parsed. + +Returns an C<XML::Atom::Feed> object. + +=cut + +sub get_feed { + my ($self, $feed, %opts) = @_; + if (ref($feed)){ + return $feed if $feed->isa('XML::Atom::Feed'); + if ($feed->isa('URI')) { + my %params = ($self->{_auth}->auth_params('GET', $feed), %opts); + my $r = $self->{_ua}->get("$feed", %params); + + my $redirect_tries = 0; + while ($r->code == 302 || $r->code == 301) { + my $location = $r->header('location'); + %params = ($self->{_auth}->auth_params('GET', $location), %opts); + $r = $self->{_ua}->get($location, %params); + $redirect_tries++; + die "Too many redirects ($redirect_tries)" + if $redirect_tries > $REDIRECT_MAX; + } + + die $r->status_line unless $r->is_success; + $feed = $r->content; + } + } + return XML::Atom::Feed->new(\$feed); +} + +=head2 update_feed <feed> + +Take an C<XML::Atom::Feed> object with a C<http://schemas.google.com/g/2005#post> link and post it. + +=cut + +sub update_feed { + my ($self, $feed) = @_; + #my $uri = Net::Google::Calendar::Base::_generic_url($feed, 'http://schemas.google.com/g/2005#post') || die("Couldn't get url"); + my $uri = Net::Google::Calendar::Base::_generic_url($feed, 'edit') || die("Couldn't get url"); + push @_, ($uri, 'POST'); + goto $self->can('_do'); +} + +# TODO collapse this with _get somehow +sub _get_entry { + my ($self, $url, $class) = @_; + my %params = ($self->{_auth}->auth_params); + my $r = $self->{_ua}->get("$url", %params); + + if (!$r->is_success) { + if ($r->code == 404) { + $@ = "EntryID not found"; + } else { + $@ = $r->status_line; + } + return; + } + my $atom = $r->content; + + my $entry = XML::Atom::Entry->new(\$atom); + $entry = bless $entry, $class; + $entry->_initialize(); + return $entry; +} + +=head2 set_calendar <Net::Google::Calendar::Calendar> + +Set the current calendar to use. + +=cut + +sub set_calendar { + my $self = shift; + my $cal = shift; + + ($self->{calendar_id}) = (uri_unescape($cal->id) =~ m!([^/]+)$!); + $self->{url} = $self->_get_protocol()."://www.google.com/calendar/feeds/$self->{calendar_id}/private/full"; +} + + +=head2 add_calendar <Net::Google::Calendar::Calendar> + +Create a new calendar + +Returns the new calendar with extra data provided by Google but will +also modify the entry in place unless the C<no_event_modification> +option is passed to C<new()>. + +Returns undef on failure. + +=cut + +sub add_calendar { + my ($self, $entry) = @_; + my $url = $self->_get_protocol()."://www.google.com/calendar/feeds/$self->{calendar_id}/owncalendars/full"; + push @_, ($url, 'POST'); + goto $self->can('_do'); +} + +=head2 update_calendar <Net::Google::Calendar::Calendar> + +Update a calendar. + +Returns the updated calendar with extra data provided by Google but will +also modify the entry in place unless the C<no_event_modification> +option is passed to C<new()>. + +Returns undef on failure. + +=cut + +sub update_calendar { + my $self = shift; + $self->update_entry(@_); +} + + +=head2 delete_calendar <Net::Google::Calendar::Calendar> [force] + +Delete a given calendar. + +Returns undef on failure or the old entry on success. + +Note that, at the moment, only C<Calendar> objects returned +by C<get_calendars> with the C<owned> parameter set to C<true> +can be deleted (unlike editing - I don't know if this is a Google +bug or not). + +However, you can pass in an optional true C<force> parameter to this +method that will allow C<Calendar> objects returned by C<get_calendars> +where no positive C<owned> paramemter was passed to be deleted. It uses +an egregious hack though and might suddenly stop working if Google change +things or I suddenly decide to remove it. + +=cut + + +sub delete_calendar { + my $self = shift; + $self->delete_entry(@_); +} + +sub _do { + my ($self, $entry, $url, $method) = @_; + + unless (defined $self->{_auth}) { + $@ = "You must log in to do a $method\n"; + return undef; + } + my $class = ref($entry); + my $xml = eval { $entry->as_xml }; + confess($@) if $@; + _utf8_off($xml); + my %params = $self->{_auth}->auth_params; + $params{Content_Type} = 'application/atom+xml; charset=UTF-8'; + $params{Content} = $xml; + $params{'X-HTTP-Method-Override'} = $method unless "POST" eq $method; + + if (defined $self->{_session_id} && !$self->{_force_no_session_id}) { + my $tmp = URI->new($url); + $tmp->query_form({ gsessionid => $self->{_session_id} }); + $url = "$tmp"; + } + + + + REQUEST: while (1) { + my $rq = POST "$url", %params; + $self->{_cookie_jar}->add_cookie_header($rq); + #my $h = HTTP::Headers->new(%params); + #my $rq = HTTP::Request->new($method => $url, $h); + my $r = $self->{_ua}->request( $rq ); + $self->{_cookie_jar}->extract_cookies($r); + my $redirect_tries = 0; + while (302 == $r->code || 301 == $r->code) { + $url = $r->header('location'); + my %args = URI->new($url)->query_form; + $self->{_session_id} = $args{gsessionid}; + $redirect_tries++; + die "Too many redirects ($redirect_tries)" + if $redirect_tries > $REDIRECT_MAX; + next REQUEST; + } + #print $rq->as_string unless $params{'X-HTTP-Method-Override'} ; + + if (!$r->is_success) { + $@ = $r->status_line." - ".$r->content." - $url"; + return undef; + } + my $c = $r->content; + if (defined $c && length($c)) { + my $tmp = $class->new(Stream => \$c); + $_[1] = $tmp unless $self->{no_event_modification}; + return $tmp; + } else { + # in the case of DELETE should we return 1 instead? + return $entry; + } + } + + +} + +sub _utf8_off { + if ($] >= 5.008) { + require Encode; + return Encode::_utf8_off($_[0]); + } +} + +=head1 WARNING + +This is ALPHA level software. + +Don't use it. Ever. Or something. + +=head1 TODO + +Abstract this out to Net::Google::Data + +=head1 LATEST VERSION + +The latest version can always be obtained from my +Subversion repository. + + http://svn.unixbeard.net/simon/Net-Google-Calendar + +=head1 AUTHOR + +Simon Wistow <simon@thegestalt.org> + +=head1 COPYRIGHT + +Copyright Simon Wistow, 2006 + +Distributed under the same terms as Perl itself. + +=head1 SEE ALSO + +http://code.google.com/apis/gdata/calendar.html + +=cut +1; diff --git a/lib/Net/Google/Calendar/Base.pm b/lib/Net/Google/Calendar/Base.pm new file mode 100644 index 0000000..2aee6b9 --- /dev/null +++ b/lib/Net/Google/Calendar/Base.pm @@ -0,0 +1,54 @@ +package Net::Google::Calendar::Base; +{ + $Net::Google::Calendar::Base::VERSION = '1.05'; +} + +use strict; +use XML::Atom::Thing; +use XML::Atom::Util qw( set_ns first nodelist childlist iso2dt); + +=head1 NAME + +Net::Google::Calendar::Base - utility functions for Net::Google::Calendar objects + +=cut + + +sub _initialize { + my $self = shift; + my $ns = XML::Atom::Namespace->new(gd => 'http://schemas.google.com/g/2005'); + $self->{_gd_ns} = $ns; +} + + + +# work round get in XML::Atom::Thing which stringifies stuff +sub _my_get { + my $obj = shift; + my($ns, $name) = @_; + my @list = $obj->_my_getlist($ns, $name); + return $list[0]; +} + +sub _my_getlist { + my $obj = shift; + my($ns, $name) = @_; + my $ns_uri = ref($ns) eq 'XML::Atom::Namespace' ? $ns->{uri} : $ns; + my @node = childlist($obj->elem, $ns_uri, $name); + return @node; +} + +sub _generic_url { + my $self = shift; + my $name = shift; + my $uri; + for ($self->link) { + next unless $name eq $_->rel; + $uri = $_; + last; + } + return undef unless defined $uri; + return $uri->href; +} + +1; diff --git a/lib/Net/Google/Calendar/Calendar.pm b/lib/Net/Google/Calendar/Calendar.pm new file mode 100644 index 0000000..87f9b0d --- /dev/null +++ b/lib/Net/Google/Calendar/Calendar.pm @@ -0,0 +1,180 @@ +package Net::Google::Calendar::Calendar; +{ + $Net::Google::Calendar::Calendar::VERSION = '1.05'; +} + +use base qw(Net::Google::Calendar::Entry); + +=head1 NAME + +Net::Google::Calendar::Calendar - entry class for Net::Google::Calendar Calendar objects + +=head1 METHODS + +Note this is very rough at the moment - there are plenty of +convenience methods that could be added but for now you'll +have to access them using the underlying C<XML::Atom::Entry> +object. + +=head2 new + +=cut + +sub new { + my ($class, %opts) = @_; + + my $self = $class->SUPER::new( Version => '1.0', %opts ); + $self->_initialize(); + return $self; +} + +sub _initialize { + my $self = shift; + + $self->{_gd_ns} = XML::Atom::Namespace->new(gd => 'http://schemas.google.com/g/2005'); + $self->{_gcal_ns} = XML::Atom::Namespace->new(gCal => 'http://schemas.google.com/gCal/2005'); +} + +=head2 summary [value] + +A summary of the calendar. + +=cut + +sub summary { + my $self= shift; + if (@_) { + $self->set($self->ns, 'summary', shift); + } + return $self->get($self->ns, 'summary'); +} + + +=head2 edit_url + +Get the edit url + +=cut + +sub edit_url { + my $self = shift; + my $force = shift || 0; + my $url = $self->_generic_url('edit'); + + $url =~ s!/allcalendars/full!/owncalendars/full! if $force; + return $url; +} + +=head2 color + +The color assigned to the calendar. + +=cut + +sub color { + my $self = shift; + if (@_) {} + if (my $el = $self->elem->getChildrenByTagName('gCal:color')->[0]) { + return $el->getAttribute('value'); + } + return; +} + +=head2 override_name + +Returns the override name of the calendar. Not always set. + +=cut + +sub override_name { + my $self = shift; + if (@_) {} + if (my $el = $self->elem->getChildrenByTagName('gCal:overridename')->[0]) { + return $el->getAttribute('value'); + } + return; +} + +=head2 access_level + +Returns the access level of the calendar. + +=cut + +sub access_level { + my $self = shift; + if (@_) {} + if (my $el = $self->elem->getChildrenByTagName('gCal:accesslevel')->[0]) { + return $el->getAttribute('value'); + } + return; +} + +=head2 hidden + +Returns true if the calendar is hidden, false otherwise + +=cut + +sub hidden { + my $self = shift; + if (@_) {} + if (my $el = $self->elem->getChildrenByTagName('gCal:hidden')->[0]) { + if ($el->getAttribute('value') eq 'true') { + return 1; + } + } + return 0; +} + + +=head2 selected + +Returns true if the calendar is selected, false otherwise. + +=cut + +sub selected { + my $self = shift; + if (@_) {} + if (my $el = $self->elem->getChildrenByTagName('gCal:selected')->[0]) { + if ($el->getAttribute('value') eq 'true') { + return 1; + } + } + return 0; +} + +=head2 time_zone + +Returns the time zone of the calendar. + +=cut + +sub time_zone { + my $self = shift; + if (@_) {} + if (my $el = $self->elem->getChildrenByTagName('gCal:timezone')->[0]) { + return $el->getAttribute('value'); + } + return; +} + + + +=head2 times_cleaned + +Returns the value of timesCleaned + +=cut + +sub times_cleaned { + my $self = shift; + if (@_) {} + if (my $el = $self->elem->getChildrenByTagName('gCal:timesCleaned')->[0]) { + return $el->getAttribute('value'); + } + return; +} + +1; diff --git a/lib/Net/Google/Calendar/Comments.pm b/lib/Net/Google/Calendar/Comments.pm new file mode 100644 index 0000000..ed62c12 --- /dev/null +++ b/lib/Net/Google/Calendar/Comments.pm @@ -0,0 +1,104 @@ +package Net::Google::Calendar::Comments; +{ + $Net::Google::Calendar::Comments::VERSION = '1.05'; +} + +use strict; +use Net::Google::Calendar::FeedLink; +use base qw(Net::Google::Calendar::Base XML::Atom::Link); + +=head1 NAME + +Net::Google::Calendar::Comments - represent comments + +=head1 SYNOPSIS + + my ($event) = $cal->get_events; + my $comments = $event->comments; + + if (!defined $comments) { + die "No comments!\n"; + } + + print "Comments are of type: ".$comments->rel."\n"; + my $feed = $comments->feed_link; + + print "There are ".$feed->count_hint." comments in this feed\n"; + print "Is this feed read only? ".$feed->read_only."\n"; + print "This feed ".(($feed->href)? "is" : "isn't" )." remote\n"; + print "This feed is of type ".$feed->rel."\n"; + foreach my $comment ($cal->get_feed($feed->feed)->entries) { + print "\t".$comment->title."\n"; + } + +=head1 METHODS + +=cut + +=head2 new + +=cut + +sub new { + my $class = shift; + my %opts = @_; + my $self = $class->SUPER::new(Version => "1.0", %opts); + return $self; +} + +=head2 rel [rel] + +Type of comments contained within. Currently, there's a +distinction between regular comments and reviews. + +Returns either C<regular> (or C<undef> which means the same) or C<reviews>. + +=cut + +sub rel { + my $self = shift; + my $pre = "http://schemas.google.com/g/2005#"; + if (@_) { + my $new = shift; + my @vals = qw(regular reviews); + die "$new is not one of the allowed values for rel (".join(",", @vals).")" + unless grep { $new eq $_ } @vals; + $self->set_attr('rel', "${pre}${new}"); + } + my $rel = $self->get_attr('rel'); + $rel =~ s!^$pre!! if defined $rel; + return $rel; +} + +=head2 element_name + +Our element name + +=cut + +sub element_name { + return 'gd:comments'; +} + +=head2 feed_link [feed_link] + +Get or set the feed link objects. + +=cut + +sub feed_link { + my $self = shift; + my $name = 'gd:feedLink'; + my $ns = ''; + #my $ns = "http://schemas.google.com/g/2005"; + if (@_) { + my $feed = shift; + XML::Atom::Base::set($self, $ns, $name, $feed, {}); + #$self->set($ns, $name, $feed, {}); + + } + my $tmp = $self->_my_get($ns, $name); + return Net::Google::Calendar::FeedLink->new(Elem => $tmp); +} + +1; diff --git a/lib/Net/Google/Calendar/Entry.pm b/lib/Net/Google/Calendar/Entry.pm new file mode 100644 index 0000000..cf05554 --- /dev/null +++ b/lib/Net/Google/Calendar/Entry.pm @@ -0,0 +1,616 @@ +package Net::Google::Calendar::Entry; +{ + $Net::Google::Calendar::Entry::VERSION = '1.05'; +} + +use strict; +use Data::Dumper; +use DateTime; +use XML::Atom; +use XML::Atom::Entry; +use XML::Atom::Util qw( set_ns first nodelist childlist iso2dt create_element); +use base qw(XML::Atom::Entry Net::Google::Calendar::Base); +use Net::Google::Calendar::Person; +use Net::Google::Calendar::Comments; + + +=head1 NAME + +Net::Google::Calendar::Entry - entry class for Net::Google::Calendar + +=head1 SYNOPSIS + + my $event = Net::Google::Calendar::Entry->new(); + $event->title('Party!'); + $event->content('P-A-R-T-Why? Because we GOTTA!'); + $event->location("My Flat, London, England"); + $event->status('confirmed'); + $event->transparency('opaque'); + $event->visibility('private'); + + my $author = Net::Google::Calendar::Person->new; + $author->name('Foo Bar'); + $author->email('foo@bar.com'); + $entry->author($author); + + + +=head1 DESCRIPTION + +=head1 METHODS + +=head2 new + +Create a new Event object + +=cut + +sub new { + my ($class, %opts) = @_; + my $self = $class->SUPER::new( Version => '1.0', %opts ); + $self->_initialize(); + return $self; +} + +sub _initialize { + my ($self) = @_; + $self->SUPER::_initialize(); + $self->category({ scheme => 'http://schemas.google.com/g/2005#kind', term => 'http://schemas.google.com/g/2005#event' } ); + $self->set_attr('xmlns:gd', 'http://schemas.google.com/g/2005'); + $self->set_attr('xmlns:gCal', 'http://schemas.google.com/gCal/2005'); + unless ( $self->{_gd_ns} ) { + $self->{_gd_ns} = XML::Atom::Namespace->new(gd => 'http://schemas.google.com/g/2005'); + } + unless ( $self->{_gcal_ns} ) { + $self->{_gcal_ns} = XML::Atom::Namespace->new(gCal => 'http://schemas.google.com/gCal/2005'); + } + +} + +=head2 id [id] + +Get or set the id. + +=cut + +=head2 title [title] + +Get or set the title. + +=cut + +=head2 content [content] + +Get or set the content. + +=cut + +sub content { + my $self= shift; + if (@_) { + $self->set($self->ns, 'content', shift); + } + return $self->SUPER::content; +} + +=head2 author [author] + +Get or set the author + +=cut + +=head2 transparency [transparency] + +Get or set the transparency. Transparency should be one of + + opaque + transparent + +=cut + +sub transparency { + my $self = shift; + return $self->_gd_element('transparency', @_); +} + + +=head2 visibility [visibility] + +Get or set the visibility. Visibility should be one of + + confidential + default + private + public + +=cut + +sub visibility { + my $self = shift; + return $self->_gd_element('visibility', @_); +} + +=head2 status [status] + +Get or set the status. Status should be one of + + canceled + confirmed + tentative + +=cut + +sub status { + my $self = shift; + return $self->_gd_element('eventStatus', @_); +} + + + +=head2 is_allday + +Get the allday flag. + +Returns 1 of event is an All Day event, 0 if not, undef if it can't be +determined. + +=cut + +sub is_allday { + my $self = shift; + + my $start = $self->_attribute_get($self->{_gd_ns}, 'when', 'startTime'); + my $end = $self->_attribute_get($self->{_gd_ns}, 'when', 'endTime'); + + my $startok = undef; + my $endok = undef; + + if ($start =~ /^[0-9]{4}-[0-1][0-9]-[0-3][0-9]$/) { $startok = 1; } + if ($end =~ /^[0-9]{4}-[0-1][0-9]-[0-3][0-9]$/) { $endok = 1; } + + if ($startok && $endok) { return 1; } + if (!$startok && !$endok) { return 0; } + return undef; +} + + +=head2 extended_property [property] + +Get or set an extended property + +=cut + +sub extended_property { + my $self = shift; + return $self->_multi_gd_element('extendedProperty', @_); +} + +sub _multi_gd_element { + my $self = shift; + $self->_gd_elem_generic(1, @_); +} + +sub _gd_element{ + my $self = shift; + $self->_gd_elem_generic(0, @_); +} + +sub _gd_elem_generic{ + my $self = shift; + my $multi = shift; + my $elem = shift; + + if ($elem eq "extendedProperty") { + if (@_) { + my $name = shift; + my $val = shift; + my $op = $multi ? 'add' : 'set'; + $self->$op($self->{_gd_ns}, "${elem}" => "", { name => $name, value => $val } ); + return $val; + } + my $ret = {}; + for my $item ($self->_my_getlist($self->{_gd_ns} ,$elem)) { + $ret->{$item->getAttribute('name')} = $item->getAttribute('value'); + } + return $ret; + } + + if (@_) { + my $val = lc(shift); + my $op = ($multi)? 'add' : 'set'; + $self->$op($self->{_gd_ns}, "${elem}", '', { value => "http://schemas.google.com/g/2005#event.${val}" }); + return $val; + } + my $val = $self->_attribute_get($self->{_gd_ns}, $elem, 'value'); + $val =~ s!^http://schemas.google.com/g/2005#event\.!!; + return $val; +} + +sub _attribute_get { + my ($self, $ns, $what, $key) = @_; + my $elem = $self->_my_get($self->{_gd_ns}, $what, $key); + + if (defined($elem) && $elem->hasAttribute($key)) { + return $elem->getAttribute($key); + } else { + return $elem; + } +} + +=head2 location [location] + +Get or set the location + +=cut + +sub location { + my $self = shift; + + if (@_) { + my $val = shift; + $self->set($self->{_gd_ns}, 'where' => '', { valueString => $val}); + return $val; + } + + return $self->_attribute_get($self->{_gd_ns}, 'where', 'valueString'); +} + + +=head2 quick_add [bool] + +Get or set whether this is a a quick add entry or not. + +=cut +sub quick_add { + my $self = shift; + + if (@_) { + my $val = ($_[0])? 'true' : 'false'; + $self->set( $self->{_gcal_ns}, quickadd => '', { value => $val } ); + return $_[0]; + } + my $val = $self->_attribute_get($self->{_gcal_ns}, 'quickadd', 'valueString'); + return ($val eq 'true'); +} + + + +=head2 when [<start> <end> [allday]] + +Get or set the start and end time as supplied as DateTime objects. +End must be more than start. + +You may optionally pass a paramter in designating if this is an all day event or not. + +Returns two DateTime objects depicting the start and end and a flag noting whether it's an all day event. + + +=cut + +sub when { + my $self = shift; + + if (@_) { + my ($start, $end, $allday) = @_; + $allday = 0 unless defined $allday; + unless ($end>=$start) { + $@ = "End is not less than start"; + return undef; + } + $start->set_time_zone('UTC'); + $end->set_time_zone('UTC'); + + my $format = $allday ? "%F" : "%FT%TZ"; + + $self->set($self->{_gd_ns}, "when", '', { + startTime => $start->strftime($format), + endTime => $end->strftime($format), + }); + } + my $start = $self->_attribute_get($self->{_gd_ns}, 'when', 'startTime'); + my $end = $self->_attribute_get($self->{_gd_ns}, 'when', 'endTime'); + my @rets; + if (defined $start) { + push @rets, $start; + } else { + return @rets; + #die "No start date ".$self->as_xml; + } + if (defined $end) { + push @rets, $end; + } + return (map { iso2dt($_) } @rets), $self->is_allday; + +} + +=head2 reminder <method> <type> <when> + +Sets a reminder on this entry. + +C<method> must be one of: + + alert email sms + +C<type> must be one of + + days hours minutes absoluteTime + +If the type is C<absoluteTime> then C<when> should be either a iso formatted date string or a DateTime object. + +=cut + +sub reminder { + my $self = shift; + my ($method, $type, $time) = @_; + return undef unless ($method =~ /alert|email|sms/); + return undef unless ($type =~ /days|hours|minutes|absoluteTime/); + $time = $time->strftime("%FT%TZ") if ref($time) && $time->isa('DateTime'); + for my $item ($self->_my_getlist($self->{_gd_ns} ,'when')) { + my $elem = create_element($self->{_gd_ns}, 'reminder'); + $elem->setAttribute('method', $method); + $elem->setAttribute($type, $time); + $item->appendChild($elem); + } + return 1; +} + + + + + +=head2 who [Net::Google::Calendar::Person[s]] + +Get or set the list of event invitees. + +If no parameters are passed then it returns a list containing zero +or more Net::Google::Calendar::Person objects. + +If you pass in one or more Net::Google::Calendar::Person objects then +they get set as the invitees. + +=cut + +# http://code.google.com/apis/gdata/elements.html#gdWho +sub who { + my $self = shift; + + my $ns_uri = ""; # $self->{_gd_ns}; + my $name = 'gd:who'; + foreach my $who (@_) { + $self->add($ns_uri,"${name}", $who, {}); + } + my @who = map { + my $person = Net::Google::Calendar::Person->new(); + for my $attr ($_->attributes) { + my $name = $attr->nodeName; + my $val = $attr->value || ""; + #print "$name = $val\n"; + eval { $person->_do('@'.$name, $val) }; + next if $@; + } + foreach my $child ($_->childNodes) { + my $name = $child->nodeName; + my $val = $child->getAttribute('value'); + #print "$name = $val\n"; + $person->_do($name, $val); + } + #print $person->as_xml; + #print "\n\n"; + $person; + } $self->_my_getlist($ns_uri,$name); +} + +=head2 comments [comment[s]] + +Get or set Comments object. + +=cut + +sub comments { + my $self = shift; + + my $ns_uri = $self->{_gd_ns}; + my $name = 'gd:comments'; + if (@_) { + $self->add($ns_uri,"${name}", shift, {}); + } + + my $tmp = $self->_my_get($ns_uri, $name); + my $comment = Net::Google::Calendar::Comments->new(); + for my $attr ($tmp->attributes) { + my $name = $attr->nodeName; + my $val = $attr->value || ""; + eval { $comment->_do('@'.$name, $val) }; + next if $@; + } + my $feed = Net::Google::Calendar::FeedLink->new(Elem => $tmp->firstChild); + $comment->feed_link($feed) if $feed; + return $comment; +} + + + + +=head2 edit_url + +Return the edit url of this event. + +=cut + + +sub edit_url { + return $_[0]->_generic_url('edit'); +} + + +=head2 self_url + +Return the self url of this event. + +=cut + + + +sub self_url { + return $_[0]->_generic_url('self'); +} + + +=head2 html_url + +Return the 'alternate' browser-friendly url of this event. + +=cut + +sub html_url { + return $_[0]->_generic_url('alternate'); +} + + + +=head2 recurrence [ Data::ICal::Entry::Event ] + +Get or set a recurrence for an entry - this is in the form of a Data::ICal::Entry::Event object. + +Returns undef if there's no recurrence event + +This will not work if C<Data::ICal> is not installed and will return undef. + +For example ... + + $event->title('Pay Day'); + $event->start(DateTime->now); + + my $recurrence = Data::ICal::Entry::Event->new(); + + + my $last_day_of_the_month = DateTime::Event::Recurrence->monthly( days => -1 ); + $recurrence->add_properties( + dtstart => DateTime::Format::ICal->format_datetime(DateTime->now), + rrule => DateTime::Format::ICal->format_recurrence($last_day_of_the_month), + ); + + $entry->recurrence($recurrence); + +To get the recurrence back: + + print $entry->recurrence->as_string; + +See + + http://code.google.com/apis/gdata/common-elements.html#gdRecurrence + +For more details + +=cut + +sub recurrence { + my $self = shift; + + # we need Data::ICal for this but we don't wnat to require it + eval { + require Data::ICal; + Data::ICal->import; + require Data::ICal::Entry::Event; + Data::ICal::Entry::Event->import; + + }; + if ($@) { + $@ = "Couldn't load Data::ICal or Data::ICal::Entry::Event: $@"; + return; + } + + # this is all one massive hack. + # I hate myself for writing this. + if (@_) { + my $event = shift; + # pesky Google Calendar needs you to remove the BEGIN:VEVENT END:VEVENT. TSSSK + my $recur = $event->as_string; + + $recur =~ s!(^BEGIN:VEVENT\n|END:VEVENT\n$)!!sg; + $self->set($self->{_gd_ns}, 'recurrence', $recur); + + return $event; + } + my $string = $self->get($self->{_gd_ns}, 'recurrence'); + return undef unless defined $string; + $string =~ s!\n+$!!g; + $string = "BEGIN:VEVENT\n${string}\nEND:VEVENT"; + my $vfile = Text::vFile::asData->new->parse_lines( split(/\n/, $string) ); + my $event = Data::ICal::Entry::Event->new(); + #return $event; + + $event->parse_object($vfile->{objects}->[0]); + return $event->entries->[0]; + +} + +=head2 add_link <link> + +Adds the link $link, which must be an XML::Atom::Link object, to the entry as a new <link> tag. For example: + + my $link = XML::Atom::Link->new; + $link->type('text/html'); + $link->rel('alternate'); + $link->href('http://www.example.com/2003/12/post.html'); + $entry->add_link($link); + +=cut + +sub add_link { + my ($self, $link) = @_; + # workaround bug in XML::Atom + $link = bless $link, 'XML::Atom::Link' if ref($link) && $link->isa('XML::Atom::Link'); + $self->SUPER::add_link($link); +} + +=head2 original_event [event] + +Get or set the original event ID. + +=cut + +sub original_event { + my $self = shift; + return $self->_gd_element('originalEvent', @_); +} + +=head1 TODO + +=over 4 + +=item more complex content + +=item more complex locations + +=item recurrency + +=item comments + +=back + +See http://code.google.com/apis/gdata/common-elements.html for details + +=head1 AUTHOR + +Simon Wistow <simon@thegestalt.org> + +=head1 COPYRIGHT + +Copyright Simon Wistow, 2006 + +Distributed under the same terms as Perl itself. + +=head1 SEE ALSO + +http://code.google.com/apis/gdata/common-elements.html + +L<Net::Google::Calendar> + +L<XML::Atom::Event> + +=cut + + + +1; diff --git a/lib/Net/Google/Calendar/FeedLink.pm b/lib/Net/Google/Calendar/FeedLink.pm new file mode 100644 index 0000000..6017ab9 --- /dev/null +++ b/lib/Net/Google/Calendar/FeedLink.pm @@ -0,0 +1,171 @@ +package Net::Google::Calendar::FeedLink; +{ + $Net::Google::Calendar::FeedLink::VERSION = '1.05'; +} + +use strict; +use XML::Atom::Feed; +use XML::Atom::Link; +use base qw(XML::Atom::Link Net::Google::Calendar::Base); +use LWP::Simple qw(get); + +=head1 NAME + +Net::Google::Calendar::FeedLink - represents a link to a feed + +=head1 SYNOPSIS + + my @feeds = $comments->feeds; + + foreach my $feed (@feeds) { + print "There are ".$feed->count_hint." comments in this feed\n"; + print "Is this feed read only? ".$feed->read_only."\n"; + print "This feed ".(($feed->href)? "is" : "isn't" )." remote\n"; + print "This feed is of type ".$feed->rel."\n"; + + my $atom = $cal->get_feed($feed->feed); # $obj is an XML::Atom::Feed + foreach my $comment ($atom->entries) { + print "\t".$comment->title."\n"; + } + } + +=head1 METHODS + +=cut + +=head2 new + +Create a new FeedLink + +=cut + +sub new { + my $class = shift; + return $class->SUPER::new(@_); +} + +=head2 count_hint + +Hints at the number of entries in the feed. +Depending on the implementation, may not be a precise count. + +=cut + +sub count_hint { + my $self = shift; + return $self->_do('@countHint', @_); +} + +=head2 element_name + +Return our Element name + +=cut + +sub element_name { + return 'gd:feedLink'; +} + +=head2 read_only [boolean] + +Specifies whether the contained feed is read-only. + +=cut + +sub read_only { + my $self = shift; + if (@_) { + my $val = @_; + push @_, ($val)? 'true' : 'false'; + } + return _convert_bool($self->_do('@readOnly', @_)); +} + +sub _convert_bool { + my $val = shift; + return '' if !defined $val; + return $val if ($val =~ m!^(\d+)$! && ($val==0 or $val==1)); + return 0 if $val eq 'false'; + return 1 if $val eq 'true'; + #die "Illegal boolean value $val"; + return ($val)? 1 : 0; +} + +=head2 rel [rel] + +Specifies the link relation; allows the service to provide +multiple types of feed links for a single entity. Has the +same semantics and allowed values as the rel attribute of +the <atom:link> element. + +=cut + +sub rel { + my $self = shift; + return $self->_do('@rel', @_); +} + + +=head2 href [url] + +Specifies the feed URI. If the nested feed is embedded and not +linked, this attribute may be omitted. + +=cut + +sub href { + my $self = shift; + return URI->new($self->_do('@href')); +} + + +sub _do { + my $self = shift; + my $name = shift; + my $attr = ($name =~ s!^@!!); + my $gd_ns = ''; # $self->{_gd_ns}; + if (@_) { + my $new = shift; + if ($attr) { + $self->set_attr($name, $new); + } else { + $self->set($gd_ns, "${name}", '', { value => "${new}" }); + } + } + my $val; + if ($attr) { + $val = $self->get_attr($name); + } else { + $val = $self->_my_get($gd_ns, "${name}"); + } + return $val; +} + +=head2 feed [feed] + +Get the Atom feed. + +Returns a URI object if the feed is remote +or a scalar containing an XML::Atom::Feed object + +=cut + +sub feed { + my $self = shift; + my $ns = ""; # "http://purl.org/atom/ns#"; + if (@_) { + my $feed = shift; + XML::Atom::Base::set($self, $ns, 'feed', $feed, {}); + #$self->add($ns, 'feed', $feed, {}); + } + my $href = $self->href; + if (defined $href) { + return URI->new($href); + } else { + my $feed = $self->_do('feed') || return; + my $tmp = XML::Atom::Feed->new( Elem => $feed ); + $tmp->{ns} = $ns; + return $tmp; + } +} +1; diff --git a/lib/Net/Google/Calendar/Person.pm b/lib/Net/Google/Calendar/Person.pm new file mode 100644 index 0000000..a6b82f9 --- /dev/null +++ b/lib/Net/Google/Calendar/Person.pm @@ -0,0 +1,139 @@ +package Net::Google::Calendar::Person; +{ + $Net::Google::Calendar::Person::VERSION = '1.05'; +} + +use strict; +use XML::Atom::Person; +use base qw(XML::Atom::Person Net::Google::Calendar::Base); + +my %allowed = ( + attendeeStatus => [qw(accepted declined invited tentative)], + attendeeType => [qw(optional required)], + rel => [qw(attendee organizer performer speaker)], + +); + +=head1 NAME + +Net::Google::Calendar::Person - a thin wrapper round XML::Atom::Person + +=head1 METHODS + +=head2 new + +=cut + +sub new { + my $class = shift; + my %opts = @_; + $opts{Version} = '1.0' unless exists $opts{Version}; + my $self = $class->SUPER::new(%opts); + $self->_initialize(); + return $self; +} + + +=head2 name [name] + +A simple string value that can be used as a representation of this person. + +=cut + +sub name { + my $self = shift; + return $self->_do('@valueString', @_); +} + +=head2 email [email] + +Get or set the email of the person + +=cut + +sub email { + my $self = shift; + $self->_do('@email', @_); +} + +=head2 attendee_status [status] + +Get or set the status of event attendee. + +See: + + http://code.google.com/apis/gdata/elements.html#gdAttendeeStatus + +Takes or returns any of the values C<accepted>, C<declined>, C<invited>, C<tentative>. + +=cut + +sub attendee_status { + my $self = shift; + $self->_do('attendeeStatus', @_); +} + +=head2 attendee_type [type] + +Get or set the type of event attendee. + +See: + + http://code.google.com/apis/gdata/elements.html#gdAttendeeType + +Takes or returns any of the values C<optional>, C<required>. + +=cut + +sub attendee_type { + my $self = shift; + $self->_do('attendeeType', @_); +} + + +=head2 rel [relationship] + +=cut + +sub rel { + my $self = shift; + $self->_do('@rel', @_); +} + + +sub _do { + my $self = shift; + my $name = shift; + my $attr = ($name =~ s!^@!!); + $name =~ s!^gd:!!; + my $vals = $allowed{$name}; + my $gd_ns = ''; # $self->{_gd_ns}; + + my $ns = (defined $vals)? "http://schemas.google.com/g/2005#event." : ""; + if (@_) { + my $new = shift; + $new =~ s!^$ns!!; + die "$new is not one of the allowed values for $name (".join(",", @$vals).")" + unless !defined $vals || grep { $new eq $_ } @$vals; + if ($attr) { + #print "Setting attr $name to ${ns}${new}\n"; + $self->set_attr($name, "${ns}${new}"); + } else { + #print "Setting child gd:$name to ${ns}${new}\n"; + $self->set($gd_ns, "gd:${name}", '', { value => "${ns}${new}" }); + } + } + my $val; + if ($attr) { + $val = $self->get_attr($name); + } else { + my $tmp = $self->_my_get($gd_ns, "gd:${name}"); + if (defined $tmp) { + $val = $tmp->getAttribute('value'); + } + # else { print "Failed to get gd:${name}\n"; } + } + $val =~ s!^$ns!! if defined $val; + return $val; +} +1; diff --git a/lib/Net/Google/Calendar/WebContent.pm b/lib/Net/Google/Calendar/WebContent.pm new file mode 100644 index 0000000..88c6bfd --- /dev/null +++ b/lib/Net/Google/Calendar/WebContent.pm @@ -0,0 +1,219 @@ +package Net::Google::Calendar::WebContent; +{ + $Net::Google::Calendar::WebContent::VERSION = '1.05'; +} + +use strict; +use XML::Atom; +use XML::Atom::Link; +#use XML::LibXML; +#use XML::Atom::Namespace; +use base qw(XML::Atom::Link Net::Google::Calendar::Base); +use vars qw(@ISA); +unshift @ISA, 'XML::Atom::Link'; +my $ns = XML::Atom::Namespace->new( + gCal => 'http://schemas.google.com/gCal/2005' +); + + +=head1 NAME + +Net::Google::Calendar::WebContent - handle web content + +=head1 SYNOPSIS + +Web content can be images ... + + my $content = Net::Google::Calendar::WebContent->new( + title => 'World Cup', + href => 'http://www.google.com/calendar/images/google-holiday.gif', + web_content => { + url => "http://www.google.com/logos/worldcup06.gif" + width => 276, + height => 120, + type => 'image/gif', + } + ); + $entry->add_link($content); + +or html ... + + my $content = Net::Google::Calendar::WebContent->new( + title => 'Embedded HTML', + href => 'http://www.example.com/favico.icon', + web_content => { + url => "http://www.example.com/some.html" + width => 276, + height => 120, + type => 'text/html', + } + ); + $entry->add_link($content); + + +or special Google Gadgets (http://www.google.com/ig/directory) + + my $content = Net::Google::Calendar::WebContent->new( + title => 'DateTime Gadget (a classic!)', + href => 'http://www.google.com/favicon.ico', + web_content => { + url => 'http://google.com/ig/modules/datetime.xml', + width => 300, + height => 136, + type => 'application/x-google-gadgets+xml', + } + ); + + +or + my $content = Net::Google::Calendar::WebContent->new( + title => 'Word of the Day', + href => 'http://www.thefreedictionary.com/favicon.ico', + ); + $content->web_content( + url => 'http://www.thefreedictionary.com/_/WoD/wod-module.xml', + width => 300, + height => 136, + type => 'application/x-google-gadgets+xml', + prefs => { Days => 1, Format => 0 }, + ); + +(note the ability to set webContentGadgetPrefs using the special prefs attribute). + +=head1 METHODS + +=head2 new [opt[s]] + +Options can be + +=over 4 + +=item title + +The title of the web content + +=item href +A url of an icon to use + +=item type + +The mime type of content. Can be either C<text/html> C<image/*> or C<application/x-google-gadgets+xml> + +Not needed for C<text/html>. + +=item web_content + +The actual web content. This just gets passed to the C<web_content()> method. + +=back + +=cut + + +sub new { + my $class = shift; + my %params = @_; + + #my $self = XML::Atom::Link->new(Version => "1.0"); + #$self = bless $self, $class; + my $ns = XML::Atom::Namespace->new(gd => 'http://schemas.google.com/g/2005'); + my $self = $class->SUPER::new(Version => "1.0", ); + $self->{_gd_ns} = $ns; + $self->rel('http://schemas.google.com/gCal/2005/webContent'); + for my $field (qw(title href)) { + die "You must pass in the field '$field' to a WebContent link\n" + unless defined $params{$field}; + $self->$field($params{$field}); + } + my $type = $params{type}; + #die "You must pass a type" unless defined $type; + $self->_set_type($type) if defined $type; + + if ($params{web_content}) { + $self->web_content(%{$params{web_content}}); + } else { + # h-h-hack + $self->web_content(empty => 1); + } + return $self; +} + +sub _set_type { + my $self = shift; + my $type = shift; + unless ($type eq 'text/html' or + $type eq 'application/x-google-gadgets+xml' or + $type =~ m!^image/!) { + die "The type param must be text/html or application/x-google-gadgets+xml or image/*\n"; + } + $self->type($type); + +} + +=head2 web_content [param[s]] + +Takes a hash of parameters. Valid are + +=over 4 + +=item url + +The url of the content. + +=item width + +The width of the content. + +=item height + +The height of the content. + +=item type + +The mime-type (see above) + +=item prefs + +This takes a hash ref and all pairs are turned into C<webContentGadgetPref> entries. + +=back + +=cut + +sub web_content { + my $self = shift; + my $name = 'gCal:webContent'; + if (@_) { + my %params = @_; + # h-h-hack + %params = () if $params{empty}; + if (my $type = delete $params{type}) { + $self->_set_type($type); + } + # egregious hack + $params{'xmlns:gd'} = 'http://schemas.google.com/g/2005'; + $params{'xmlns:gCal'} = 'http://schemas.google.com/gCal/2005'; + my $prefs = delete $params{prefs}; + XML::Atom::Base::set($self, '', $name, '', \%params); + my $content = $self->_my_get('', $name); + foreach my $key (keys %{$prefs}) { + # TODO: this feels icky + my $node; + if (LIBXML) { + $node = XML::LibXML::Element->new($name.'GadgetPref'); + $node->setAttribute( name => $key ); + $node->setAttribute( value => $prefs->{$key} ); + } else { + $node = XML::XPath::Node::Element->new($name.'GadgetPref'); + $node->addAttribute(XML::XPath::Node::Attribute->new(name => $key)); + $node->addAttribute(XML::XPath::Node::Attribute->new(value => $prefs->{key})); + } + $content->appendChild($node); + } + } + return $self->_my_get('', $name); +} + +1; + + diff --git a/t/01use.t b/t/01use.t new file mode 100755 index 0000000..0615477 --- /dev/null +++ b/t/01use.t @@ -0,0 +1,11 @@ +#!perl -w + +use strict; +use Test::More tests => 5; + +use_ok('Net::Google::Calendar'); +use_ok('Net::Google::Calendar::Entry'); +use_ok('Net::Google::Calendar::Person'); +use_ok('Net::Google::Calendar::Calendar'); +use_ok('Net::Google::Calendar::WebContent'); + diff --git a/t/02events.t b/t/02events.t new file mode 100644 index 0000000..471f0cd --- /dev/null +++ b/t/02events.t @@ -0,0 +1,17 @@ +#!perl -w + +use strict; +use Net::Google::Calendar; +use Net::Google::Calendar::Entry; +use lib qw(t/lib); +use GCalTest; +use Test::More; + +our $cal = eval { GCalTest::get_calendar('login') }; +if ($@) { + plan skip_all => "because $@"; +} else { + plan tests => 16; +} + +do('t/02events_base'); diff --git a/t/02events_base b/t/02events_base new file mode 100644 index 0000000..34ee409 --- /dev/null +++ b/t/02events_base @@ -0,0 +1,59 @@ +# get events +my @events = eval { $cal->get_events() }; +is($@, '', "Got events"); + +# should be none +is(scalar(@events), 0, "No events so far"); + +# create an event +my $title = "Test event ".time(); +my $entry = Net::Google::Calendar::Entry->new(); +$entry->title($title); +ok($cal->add_entry($entry), "Added an entry"); + + +# check updated event object +my $id = $entry->id; +isnt($id, undef, "Added event has an id"); + + +# get events again +ok(@events = $cal->get_events(), "Got events again"); + +# should be one +is(scalar(@events), 1, "Got an event"); + +# check listed events +is($events[0]->title, $title, "Retrieved event has correct title"); + +# update event +$title = "Test event updated title ".time(); +ok($entry->title($title), "Changed event title"); +ok($cal->update_entry($entry), "And updated it"); + + +# check updated event object again +# TODO check a revision number +is($entry->id, $id, "Got same id"); + +# get events once again +ok((@events = $cal->get_events()), "Got events again"); + +# should be one still +is(scalar(@events), 1, "Got one event still"); + +# check listed event again +is($events[0]->title, $title, "Retrieved event has correct title"); + +# delete event +ok($cal->delete_entry($entry), "Deleted event"); + +# get events once again +@events = eval { $cal->get_events() }; +is($@, '', "Got events again"); + +# should be none +is(scalar(@events), 0, "Got one no events"); + + + diff --git a/t/03calendars.t b/t/03calendars.t new file mode 100644 index 0000000..6f14d6e --- /dev/null +++ b/t/03calendars.t @@ -0,0 +1,85 @@ +#!perl -w + +use strict; +use Net::Google::Calendar; +use Net::Google::Calendar::Calendar; +use lib qw(t/lib); +use GCalTest; +use Test::More; + +my $cal = eval { GCalTest::get_calendar('login') }; +if ($@) { + plan skip_all => "because $@"; +} else { + plan tests => 22; +} + + +# Get a list of calendars +my @calendars; +ok(@calendars = $cal->get_calendars(), "Got calendars"); + +# Should contain default +is(scalar(@calendars), 1, "We've got 1 calendar"); +my $default = $calendars[0]; + +# Create a new calendar +my $new_cal = Net::Google::Calendar::Calendar->new; +$new_cal->title("Foo"); +$new_cal->summary("A new test calendar"); +ok($cal->add_calendar($new_cal), "Added calendar"); + +# Check reference +my $updated = $new_cal->updated; +isnt($updated, undef, "Updated was supplied"); + +# Get list again +ok(@calendars = $cal->get_calendars(), "Got calendars again"); +is(scalar(@calendars), 2, "We've got 2 calendars"); + +sleep(1); + +# Update +$new_cal->summary("Updated test calendar"); +ok($cal->update_calendar($new_cal), "Updated calendar"); + +# Check reference +isnt($new_cal->updated, $updated, "Not same updated time"); + +# Get list again +ok(@calendars = $cal->get_calendars(), "Got calendars again"); +is(scalar(@calendars), 2, "We've still got 2 calendars"); + +# Check list version +# TODO this is brittle - need to grep out +is($calendars[1]->title, $new_cal->title, "List version title is the same"); + +# Delete +ok($cal->delete_calendar($calendars[1], 1), "Deleted calendar"); + +# Get list +ok(@calendars = $cal->get_calendars(), "Got calendars again"); +is(scalar(@calendars), 1, "We've still got 1 calendar again"); + +# Add another calendar +$new_cal = Net::Google::Calendar::Calendar->new; +$new_cal->title("Foo again"); +$new_cal->summary("A new test calendar again"); +ok($cal->add_calendar($new_cal), "Added another calendar"); +ok($cal->set_calendar($new_cal), "Set the calendar"); + +# Add event to one calendar +my $entry = Net::Google::Calendar::Entry->new(); +$entry->title("Testing"); +ok($cal->add_entry($entry), "Added entry"); +is(scalar($cal->get_events()), 1, "Got entry back"); + +# Check another +ok($cal->set_calendar($default), "Set the calendar again"); +is(scalar($cal->get_events()), 0, "Got no entries back"); + +# Delete event +ok($cal->set_calendar($new_cal), "Set the calendar again"); +ok($cal->delete_calendar($new_cal, 1), "Deleted calendar again"); + + diff --git a/t/04attendees.t b/t/04attendees.t new file mode 100644 index 0000000..4df1753 --- /dev/null +++ b/t/04attendees.t @@ -0,0 +1,126 @@ +#!perl -w + +use strict; +use Net::Google::Calendar; +use Net::Google::Calendar::Person; +use lib qw(t/lib); +use GCalTest; +use Test::More; + +my $cal = eval { GCalTest::get_calendar('login') }; +if ($@) { + plan skip_all => "because $@"; +#} elsif (!defined $ENV{GCAL_TEST_ATTENDEE} || !defined $ENV{GCAL_TEST_ATTENDEE_NAME}) { +# plan skip_all => "because you need have set GCAL_TEST_ATTENDEE and GCAL_TEST_ATTENDEE_NAME environment variables which are the details of a real user"; +} else { + plan tests => 26; +} + +my $email = $ENV{GCAL_TEST_ATTENDEE} || 'test@example.com'; +my $name = $ENV{GCAL_TEST_ATTENDEE_NAME} || 'Tester'; +my $status = 'declined'; +my $type = 'required'; +my $rel = 'organizer'; + + +# get events +my @events = eval { $cal->get_events() }; +is($@, '', "Got events"); + +# should be none +is(scalar(@events), 0, "No events so far"); + +# create an event +my $title = "Test attendee event ".time(); +my $entry = Net::Google::Calendar::Entry->new(); +$entry->title($title); + +my $who = Net::Google::Calendar::Person->new; + + +# name +ok($who->name($name), "Added name"); + +# email +ok($who->email($email), "Added email"); + +# type +eval { $who->attendee_type('useless') }; +isnt($@, '', "Caught bogus attendee_type"); +eval { $who->attendee_type($type) }; +is($@, '', "Set attendee_type"); + +# status +eval { $who->attendee_status('useless') }; +isnt($@, '', "Caught bogus attendee_status"); +eval { $who->attendee_status($status) }; +is($@, '', "Set attendee_status"); + + + + +# rel +eval { $who->rel('useless') }; +isnt($@, '', "Caught bogus rel"); +eval { $who->rel($rel) }; +is($@, '', "Set rel"); + + +ok($entry->who($who), "Added person"); + +ok($cal->add_entry($entry), "Added an entry"); + + + +# get events again +ok(@events = $cal->get_events(), "Got events again"); + +# should be one +is(scalar(@events), 1, "Got an event"); + +SKIP: { + +skip "Couldn't get events back", 9 unless scalar(@events); + +my @who = $events[0]->who; +ok(scalar(@who), "Got people back"); +skip "Couldn't get people back ", 8 unless scalar(@who); + + +my $new_who = $who[0]; + + +# name again +SKIP: { + skip "Google Bug", 2; + is($new_who->name, $name, "Got name"); + is($new_who->name, $who->name, "Got same name"); +} + +# email again +is($new_who->email, $email, "Got email"); +is($new_who->email, $who->email, "Got same email"); + +# status again +is($new_who->attendee_status(), $status, "Got attendee status"); +is($new_who->attendee_status(), $who->attendee_status(), "Got same attendee status"); + + +SKIP: { + skip "Not implemented by Google", 2; + # type again + is($new_who->attendee_type(), $type, "Got attendee type"); + is($new_who->attendee_type(), $who->attendee_type(), "Got same attendee type"); +} + +SKIP: { + skip "Google Bug", 2; + # rel again + is($new_who->rel(), $rel, "Got attendee rel"); + is($new_who->rel(), $who->rel(), "Got same rel"); +} + +# delete +ok($cal->delete_entry($entry), "Deleted"); + +} diff --git a/t/05comments.t b/t/05comments.t new file mode 100644 index 0000000..e89a7e7 --- /dev/null +++ b/t/05comments.t @@ -0,0 +1,95 @@ +#!perl -w + +use strict; +use Net::Google::Calendar; +use XML::Atom::Feed; +use lib qw(t/lib); +use GCalTest; +use Test::More; + +my $cal = eval { GCalTest::get_calendar('login') }; +if ($@) { + plan skip_all => "because $@"; +} else { + plan tests => 6; + #plan skip_all => "Can't for the life of me get this to work"; +} + +use_ok("Net::Google::Calendar::FeedLink"); +use_ok("Net::Google::Calendar::Comments"); + + +my @events = eval { $cal->get_events() }; +is($@, '', "Got events"); + +# should be none +is(scalar(@events), 0, "No events so far"); + +# create an event +my $title = "Test attendee event ".time(); +my $entry = Net::Google::Calendar::Entry->new(); +$entry->title($title); + +# add it +my $saved; +if (@events){ + $saved = $events[0]; +} else { + $saved = $cal->add_entry($entry); +} +ok($saved, "Saved entry"); + +eval { +# get the comment url +my $fl = $saved->comments->feed_link; +my $uri = $fl->href; +my $feed = $cal->get_feed($uri); + +my $comment = Net::Google::Calendar::Entry->new; + +my $atom = XML::Atom::Namespace->new(atom => 'http://www.w3.org/2005/Atom'); + +$feed = XML::Atom::Feed->new; +my $link = XML::Atom::Link->new; +$link->type('application/xml'); +$link->rel('http://schemas.google.com/g/2005#post'); +$link->href("$uri"); +$feed->add_link($link); + + +my %ns = ( + atom => 'http://www.w3.org/2005/Atom', + gAcl => 'http://schemas.google.com/acl/2007', + batch => 'http://schemas.google.com/gdata/batch', + gCal => 'http://schemas.google.com/gCal/2005', + gd => 'http://schemas.google.com/g/2005', +); + +foreach my $key (keys %ns) { + $feed->set_attr("xmlns:${key}" => $ns{$key}); +} + + +$comment->set($atom, 'category', undef, { scheme => 'http://schemas.google.com/g/2005#kind', term => 'http://schemas.google.com/g/2005#message' } ); + +$comment->set($atom, 'content', "test comment", { type => 'text' }); +my $author = XML::Atom::Person->new; +$author->set($atom, 'name', "Simon Wistow"); +$author->set($atom, 'email', $ENV{GCAL_TEST_USER}); +$comment->set($atom, 'author', $author); + + +#$feed->add_entry($comment); +$feed->set($atom, 'entry', $comment, {}, 1); + +print $feed->as_xml; + +my $return = $cal->update_feed($feed); +die $@ unless defined $return; +print $return->as_xml; + +# create a new feed +}; +print "Error: $@\n" if $@; +ok($cal->delete_entry($saved), "Deleted entry"); + diff --git a/t/TODO b/t/TODO new file mode 100644 index 0000000..5844c8c --- /dev/null +++ b/t/TODO @@ -0,0 +1,4 @@ +- Check all 3 ways of authenticating +- Check change by reference +- Check WebContent and Person +- Complex searches diff --git a/t/lib/GCalTest.pm b/t/lib/GCalTest.pm new file mode 100644 index 0000000..188fb8f --- /dev/null +++ b/t/lib/GCalTest.pm @@ -0,0 +1,37 @@ +package GCalTest; + +sub get_calendar { + my $how = shift; + my $cal = Net::Google::Calendar->new(); + return &$how($cal); +} + +sub login { + my $cal = shift; + die "we need GCAL_TEST_USER and GCAL_TEST_PASS env variables\n" + unless defined $ENV{GCAL_TEST_USER} && defined $ENV{GCAL_TEST_PASS}; + + $cal->login($ENV{GCAL_TEST_USER}, $ENV{GCAL_TEST_PASS}) + or die "Couldn't login: $@\n"; + return $cal; +} + + +sub magic { + die "we need GCAL_TEST_MAGIC_URL env variables\n" + unless defined $ENV{GCAL_TEST_MAGIC_URL}; + return Net::Google::Calendar->new( url => $ENV{GCAL_TEST_MAGIC_URL} ); + +} + +sub authsub { + my $cal = shift; + die "we need GCAL_TEST_USER and GCAL_TEST_AUTH_TOKEN env variables\n" + unless defined $ENV{GCAL_TEST_USER} && defined $ENV{GCAL_TEST_AUTH_TOKEN}; + $cal->auth($ENV{GCAL_TEST_USER}, $ENV{GCAL_TEST_AUTH_TOKEN}) + or die "Couldn't authenticate: $@\n"; + return $cal; +} + + +1; diff --git a/t/pod-coverage.t b/t/pod-coverage.t new file mode 100644 index 0000000..0ac0cda --- /dev/null +++ b/t/pod-coverage.t @@ -0,0 +1,8 @@ +#!perl -T + +use strict; +use warnings; +use Test::More; +eval 'use Test::Pod::Coverage 1.04'; +plan skip_all => 'Test::Pod::Coverage 1.04 required for testing POD coverage' if $@; +all_pod_coverage_ok(); diff --git a/t/pod.t b/t/pod.t new file mode 100644 index 0000000..bdb151c --- /dev/null +++ b/t/pod.t @@ -0,0 +1,9 @@ +#!perl -T + +use strict; +use warnings; + +use Test::More; +eval 'use Test::Pod 1.14'; +plan skip_all => 'Test::Pod 1.14 required for testing POD' if $@; +all_pod_files_ok();