Cal-DAV-0.6/000755 001752 001752 00000000000 10723567455 013024 5ustar00simonsimon000000 000000 Cal-DAV-0.6/lib/000755 001752 001752 00000000000 10723567455 013572 5ustar00simonsimon000000 000000 Cal-DAV-0.6/t/000755 001752 001752 00000000000 10723567455 013267 5ustar00simonsimon000000 000000 Cal-DAV-0.6/META.yml000444 001752 001752 00000000700 10723567455 014270 0ustar00simonsimon000000 000000 --- name: Cal-DAV version: 0.6 author: - 'Simon Wistow ' abstract: a CalDAV client license: perl resources: license: http://dev.perl.org/licenses/ requires: Data::ICal: 0.12 HTTP::DAV: 0.31 LWP: 5.808 Test::More: 0.62 provides: Cal::DAV: file: lib/Cal/DAV.pm version: 0.6 generated_by: Module::Build version 0.2808 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 Cal-DAV-0.6/MANIFEST000444 001752 001752 00000000313 10723567455 014150 0ustar00simonsimon000000 000000 Build.PL lib/Cal/DAV.pm MANIFEST This list of files META.yml t/00use.t t/01basics.t t/02locks.t t/03auto_commit.t t/CalDAVTest.pm t/ics/birthdays.ics t/ics/new.ics t/pod-coverage.t t/pod.t Makefile.PL Cal-DAV-0.6/Makefile.PL000444 001752 001752 00000001044 10723567455 014773 0ustar00simonsimon000000 000000 # Note: this file was auto-generated by Module::Build::Compat version 0.03 use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'Cal::DAV', 'VERSION_FROM' => 'lib/Cal/DAV.pm', 'PREREQ_PM' => { 'Data::ICal' => '0.12', 'HTTP::DAV' => '0.31', 'LWP' => '5.808', 'Test::More' => '0.62' }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; Cal-DAV-0.6/Build.PL000555 001752 001752 00000000777 10723567455 014334 0ustar00simonsimon000000 000000 use strict; use Module::Build; my $build = Module::Build ->new( module_name => "Cal::DAV", license => 'perl', requires => { 'Test::More' => '0.62', 'Data::ICal' => '0.12', 'HTTP::DAV' => '0.31', 'LWP' => '5.808', }, scripts => [], create_makefile_pl => 'traditional', ); $build->create_build_script; Cal-DAV-0.6/t/00use.t000444 001752 001752 00000000465 10723567455 014413 0ustar00simonsimon000000 000000 #!perl -w use strict; use Test::More tests => 3; # Use use_ok("Cal::DAV"); # Wrong instantiation my $cal; is( eval { $cal = Cal::DAV->new() }, undef, "Wrong instantiation"); # Right instantiation ok($cal = Cal::DAV->new(user => 'foo', pass => 'pass', url => 'http://example.com'), "Right instantiation"); Cal-DAV-0.6/t/CalDAVTest.pm000444 001752 001752 00000000602 10723567455 015513 0ustar00simonsimon000000 000000 package CalDAVTest; use Cal::DAV; use base qw(Exporter); use vars qw(@EXPORT); @EXPORT = qw(get_cal_dav); sub get_cal_dav { my $file = shift; my $commit = shift || 0; return eval { Cal::DAV->new( user => $ENV{CAL_DAV_USER}, pass => $ENV{CAL_DAV_PASS}, url => $ENV{CAL_DAV_URL_BASE}."/$file", auto_commit => $commit, ) }; } 1; Cal-DAV-0.6/t/03auto_commit.t000444 001752 001752 00000001111 10723567455 016127 0ustar00simonsimon000000 000000 #!perl -w use strict; use lib qw(t); use Cal::DAV; use Test::More; use CalDAVTest; for (qw(CAL_DAV_USER CAL_DAV_PASS CAL_DAV_URL_BASE)) { if (!defined $ENV{$_}) { plan skip_all => "Need to provide a $_ environment variable"; } } plan tests => 5; my $cal; ok($cal = get_cal_dav('new.ics', 1), "Instantiated ok"); # Parse ok($cal->parse(filename => 't/ics/new.ics'), "Parsed a file"); # Destroy $cal = undef; # Get ok($cal = get_cal_dav('new.ics'), "Instantiated ok again"); # Check is(scalar(@{$cal->entries}), 1, "Got 1 entry"); ok($cal->delete, "Delete"); Cal-DAV-0.6/t/pod-coverage.t000444 001752 001752 00000000306 10723567455 016024 0ustar00simonsimon000000 000000 #!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(); Cal-DAV-0.6/t/ics/000755 001752 001752 00000000000 10723567455 014045 5ustar00simonsimon000000 000000 Cal-DAV-0.6/t/02locks.t000444 001752 001752 00000001662 10723567455 014734 0ustar00simonsimon000000 000000 #!perl -w use strict; use lib qw(t); use Cal::DAV; use Test::More; use CalDAVTest; for (qw(CAL_DAV_USER CAL_DAV_PASS CAL_DAV_URL_BASE)) { if (!defined $ENV{$_}) { plan skip_all => "Need to provide a $_ environment variable"; } } plan tests => 11; # Parse my $cal; ok($cal = get_cal_dav('birthday.ics'), "Instantiated ok"); ok($cal->parse(filename => 't/ics/birthdays.ics'), "Parsed a file"); # Put ok($cal->save, "Put"); # Lock ok($cal->lock, "Locked first cal"); # Fail to obtain lock my $cal2; ok($cal2 = get_cal_dav('birthday.ics'), "Instantiated ok"); ok(!$cal2->lock, "Failed to get lock with second cal"); # Unlock ok($cal->unlock, "Unlocked first cal"); # Obtain lock ok($cal2->lock, "Got lock with second cal"); # Forceably unlock ok($cal->forcefully_unlock_all, "First cal forcefully unlocked"); # Lock ok($cal->lock, "First cal got lock back"); # Steal lock ok($cal2->steal_lock, "Second cal stole lock"); Cal-DAV-0.6/t/pod.t000444 001752 001752 00000000247 10723567455 014237 0ustar00simonsimon000000 000000 #!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(); Cal-DAV-0.6/t/01basics.t000444 001752 001752 00000002365 10723567455 015065 0ustar00simonsimon000000 000000 #!perl -w use strict; use lib qw(t); use Cal::DAV; use Test::More; use CalDAVTest; use Data::ICal; #use HTTP::DAV; #HTTP::DAV::DebugLevel(3); for (qw(CAL_DAV_USER CAL_DAV_PASS CAL_DAV_URL_BASE)) { if (!defined $ENV{$_}) { plan skip_all => "Need to provide a $_ environment variable"; } } plan tests => 14; my $cal; ok($cal = get_cal_dav('birthday.ics'), "Instantiated ok"); # Parse ok($cal->parse(filename => 't/ics/birthdays.ics'), "Parsed a file"); # Save ok($cal->save, "Saved"); # Get $cal = undef; ok($cal = get_cal_dav('birthday.ics'), "Instantiated again"); # Check my $entries; ok($entries = $cal->entries, "Got entries"); is(scalar(@$entries), 1, "Got 1 entry"); # Modify ok($cal->add_entry(make_entry()), "Added an entry"); # Save ok($cal->save, "Save modified calendar"); # Get ok($entries = $cal->entries, "Got entries after modification"); is(scalar(@$entries), 2, "Got 2 entries"); # Check $cal = undef; ok($cal = get_cal_dav('birthday.ics'), "Instantiated yet again"); ok($entries = $cal->entries, "Got entries after modification and destroy"); is(scalar(@$entries), 2, "Still got 2 entries"); # Delete ok($cal->delete, "Deleted"); sub make_entry { my $d = Data::ICal->new( filename => 't/ics/new.ics' ); return $d->entries->[0]; } Cal-DAV-0.6/t/ics/new.ics000444 001752 001752 00000000260 10723567455 015332 0ustar00simonsimon000000 000000 BEGIN:VCALENDAR PRODID:ByHand VERSION:2.0 BEGIN:VEVENT DESCRIPTION:New Event DTSTART:19700101 RRULE:YEARLY SUMMARY: New Event UID:newevent@example.com END:VEVENT END:VCALENDAR Cal-DAV-0.6/t/ics/birthdays.ics000555 001752 001752 00000000306 10723567455 016536 0ustar00simonsimon000000 000000 BEGIN:VCALENDAR PRODID:ByHand VERSION:2.0 BEGIN:VEVENT DESCRIPTION:Someone's Birthday DTSTART:19700101 RRULE:FREQ=YEARLY SUMMARY:Someone's Birthday UID:birthday@example.com END:VEVENT END:VCALENDAR Cal-DAV-0.6/lib/Cal/000755 001752 001752 00000000000 10723567455 014271 5ustar00simonsimon000000 000000 Cal-DAV-0.6/lib/Cal/DAV.pm000444 001752 001752 00000020266 10723567455 015245 0ustar00simonsimon000000 000000 package Cal::DAV; use strict; use Data::ICal; use HTTP::DAV; our $VERSION="0.6"; =head1 NAME Cal::DAV - a CalDAV client =head1 SYNOPSIS my $cal = Cal::DAV->new( user => $user, pass => $pass, url => $url); # the ics data will be fetched automatically if it's there # ... or you can parse some ics $cal->parse(filename => $data); # cal now has all the methods of Data::ICal # you can now monkey around with the object # saves the updated calendar $cal->save; # deletes the calendar $cal->delete; # lock the file on the server $cal->lock; # unlock the file on the server $cal->unlock # steal the lock $cal->steal_lock; # also $cal->forcefully_unlock_all # and $cal->lockdiscovery # resyncs it with the server $cal->get; # Get the underlying HTTP::DAV object my $dav = $cal->dav; =head1 DESCRIPTION C is actually a very thin wrapper round C and C but it may gain more functionality later and, in the mean time, serves as something that =head1 TESTING In order to test you need to define three environment variables: C, C and C which points to a DAV collection that the user supplied has write permissions for. It should be noted that, at the moment, I'm having problems finding a CalDAV server that allows me to create files and so I can't run all the tests. =head1 METHODS =cut =head2 new Must have at least C, C and C args where C is the url of a remote, DAV accessible C<.ics> file. Can optionally take an C option. See C method below. =cut # TODO if we remove the option to do operations with other urls # we could then cache the resource object sub new { my $class = shift; my %args = @_; my %opts; for (qw(user pass url)) { die "You must pass in a $_ param\n" unless defined $args{$_}; $opts{"-${_}"} = $args{$_}; } my $dav = HTTP::DAV->new; $dav->credentials(%opts); return bless { _dav => $dav, url => $args{url}, _auto_commit => $args{auto_commit} }, $class; } =head2 parse Make a new calendar object using same arguments as C's C or C methods. Does not auto save for you. Returns 1 on success and 0 on failure. =cut sub parse { my $self = shift; my %args = @_; $self->{_cal} = Data::ICal->new(%args); return (defined $self->{_cal}) ? $self->dav->ok("Loaded data successfully") : $self->dav->err('ERR_GENERIC', "Failed to load calendar: parse error $@"); } =head2 save [url] Save the calendar back to the server (or optionally to another path). Returns 1 on success and 0 on failure. =cut sub save { my $self = shift; my $url = shift || $self->{url}; my $cal = $self->{_cal}; # TODO should this be cal() return 1 unless defined $cal; my $res = $self->dav->new_resource( -uri => $url ); #unless ($self->{_fetched}) { #my $ret = $res->mkcol; #unless ($ret->is_success) { # return $self->dav->err( 'ERR_RESP_FAIL',"mkcol in put failed ".$ret->message(), $url); #} #$self->{_fetched} = 1; #} my $data = $cal->as_string; my $ret = $res->put($data); if ($ret->is_success) { return $self->dav->ok( "put $url (" . length($data) ." bytes)",$url ); } else { return $self->dav->err( 'ERR_RESP_FAIL',"put failed ".$ret->message(), $url); } } =head2 delete [url] Delete the file on the server or optionally another url. Returns 1 on success and 0 on failure. =cut sub delete { my $self = shift; my $url = shift || $self->{url}; my $res = $self->dav->new_resource( -uri => $url ); my $ret = $res->delete(); if ($ret->is_success) { return $self->dav->ok( "deleted $url successfully", $url ); } else { return $self->dav->err( 'ERR_RESP_FAIL',$ret->message(), $url); } } =head2 get [url] Refetch the file from the sever to sync it - Alternatively fetch an alternative url. These will lose any local changes. =cut sub get { my $self = shift; my $url = shift || $self->{url}; my $res = $self->dav->new_resource( -uri => $url ); my $ret = $res->get(); if ($ret->is_success) { $self->{_fetched} = 1; #return $self->dav->ok("get $url", $url, $ret->content_length() ); } else { return $self->dav->err('ERR_GENERIC', "get $url failed: ". $ret->message, $url); } my $data = $res->get_content(); return $self->dav->err('ERR_GENERIC', "Couldn't get data from $url", $url) unless defined $data; return $self->parse(data => $data); } =head2 lock Same options as C's C. =cut sub lock { my $self = shift; my $resp = $self->_do_on_dav('lock', @_); if ( $resp->is_success() ) { return $self->dav->ok( "lock $self->{url} succeeded",$self->{url} ); } else { return $self->dav->err( 'ERR_RESP_FAIL',$resp->message, $self->{url} ); } } =head2 unlock Same options as C's C. =cut sub unlock { my $self = shift; my $resp = $self->_do_on_dav('unlock', @_); if ( $resp->is_success ) { return $self->dav->ok( "unlock $self->{url} succeeded",$self->{url} ); } else { # The Resource.pm::lock routine has a hack # where if it doesn't know the locktoken, it will # just return an empty response with message "Client Error". # Make a custom message for this case. my $msg = $resp->message; if ( $msg=~ /Client error/i ) { $msg = "No locks found. Try steal"; return $self->dav->err( 'ERR_GENERIC',$msg,$self->{url} ); } else { return $self->dav->err( 'ERR_RESP_FAIL',$msg,$self->{url} ); } } } =head2 steal_lock Same options as C's C. =cut sub steal_lock { my $self = shift; my $resp = $self->_do_on_dav('steal_lock', @_); if ( $resp->is_success() ) { return $self->dav->ok( "steal succeeded",$self->{url} ); } else { return $self->dav->err( 'ERR_RESP_FAIL',$resp->message(),$self->{url} ); } } =head2 lockdiscovery Same options as C's C. =cut sub lockdiscovery { my $self = shift; my $resp = $self->_do_on_dav('lockdiscovery', @_); } =head2 forcefully_unlock_all Same options as C's C. =cut sub forcefully_unlock_all { my $self = shift; $self->_do_on_dav('forcefully_unlock_all', @_); } sub _do_on_dav { my $self = shift; my $meth = shift; my $url = $self->{url}; my $res = $self->dav->new_resource( -uri => $url ); $res->$meth(@_); } =head2 dav [HTTP::DAV] Get the underlying C object or, alterntively, replace it with a a new one. =cut sub dav { my $self = shift; if (@_) { $self->{_dav} = shift; } return $self->{_dav}; } =head2 cal Get the underlying cal object =cut sub cal { my $self = shift; if (!defined $self->{_cal}) { my $ret = $self->get || die "Couldn't autofetch calendar: ".$self->dav->message; } return $self->{_cal}; } =head2 auto_commit [boolean] Whether to auto save on desctruction or not. Defaults to 0. =cut sub auto_commit { my $self = shift; if (@_) { $self->{_auto_commit} = shift; } return $self->{_auto_commit}; } =head2 message Same as C's C function. =cut sub message { my $self = shift; return $self->dav->message; } =head2 errors Same as C's C function. =cut sub errors { my $self = shift; return $self->dav->errors; } use Carp qw(croak confess cluck); our $AUTOLOAD; sub AUTOLOAD { my $self = shift; my $method = $AUTOLOAD; $method =~ s/.*://; # strip fully-qualified portion # TODO should we cache this in a glob? $self->cal->$method(@_) } sub DESTROY { my $self = shift; $self->save if $self->auto_commit; } =head1 AUTHOR Simon Wistow =head1 COPYRIGHT Copyright 2007, Simon Wistow Released under the same terms as Perl itself. =head1 SEE ALSO L L http://tools.ietf.org/html/rfc4791 =cut 1;