[Rt-commit] r3650 - in Data-ICal: . inc/Module inc/Module/Install
lib/Data t
glasser at bestpractical.com
glasser at bestpractical.com
Mon Aug 15 16:18:32 EDT 2005
Author: glasser
Date: Mon Aug 15 16:18:30 2005
New Revision: 3650
Modified:
Data-ICal/ (props changed)
Data-ICal/inc/Module/Install.pm
Data-ICal/inc/Module/Install/Base.pm
Data-ICal/inc/Module/Install/Can.pm
Data-ICal/inc/Module/Install/Fetch.pm
Data-ICal/inc/Module/Install/Makefile.pm
Data-ICal/inc/Module/Install/Metadata.pm
Data-ICal/inc/Module/Install/Win32.pm
Data-ICal/inc/Module/Install/WriteAll.pm
Data-ICal/lib/Data/ICal.pm
Data-ICal/t/08.parse.t
Log:
r39549 at tin-foil: glasser | 2005-08-15 15:58:05 -0400
API change: Data::ICal->new(filename => ...) or ->new(data => ...) but not just ->new($filename)
Modified: Data-ICal/inc/Module/Install.pm
==============================================================================
--- Data-ICal/inc/Module/Install.pm (original)
+++ Data-ICal/inc/Module/Install.pm Mon Aug 15 16:18:30 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install.pm - /usr/local/share/perl/5.8.4/Module/Install.pm"
+#line 1 "inc/Module/Install.pm - /Library/Perl/5.8.6/Module/Install.pm"
package Module::Install;
$VERSION = '0.36';
Modified: Data-ICal/inc/Module/Install/Base.pm
==============================================================================
--- Data-ICal/inc/Module/Install/Base.pm (original)
+++ Data-ICal/inc/Module/Install/Base.pm Mon Aug 15 16:18:30 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/Base.pm - /usr/local/share/perl/5.8.4/Module/Install/Base.pm"
+#line 1 "inc/Module/Install/Base.pm - /Library/Perl/5.8.6/Module/Install/Base.pm"
package Module::Install::Base;
#line 28
Modified: Data-ICal/inc/Module/Install/Can.pm
==============================================================================
--- Data-ICal/inc/Module/Install/Can.pm (original)
+++ Data-ICal/inc/Module/Install/Can.pm Mon Aug 15 16:18:30 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/Can.pm - /usr/local/share/perl/5.8.4/Module/Install/Can.pm"
+#line 1 "inc/Module/Install/Can.pm - /Library/Perl/5.8.6/Module/Install/Can.pm"
package Module::Install::Can;
use Module::Install::Base; @ISA = qw(Module::Install::Base);
$VERSION = '0.01';
Modified: Data-ICal/inc/Module/Install/Fetch.pm
==============================================================================
--- Data-ICal/inc/Module/Install/Fetch.pm (original)
+++ Data-ICal/inc/Module/Install/Fetch.pm Mon Aug 15 16:18:30 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/Fetch.pm - /usr/local/share/perl/5.8.4/Module/Install/Fetch.pm"
+#line 1 "inc/Module/Install/Fetch.pm - /Library/Perl/5.8.6/Module/Install/Fetch.pm"
package Module::Install::Fetch;
use Module::Install::Base; @ISA = qw(Module::Install::Base);
Modified: Data-ICal/inc/Module/Install/Makefile.pm
==============================================================================
--- Data-ICal/inc/Module/Install/Makefile.pm (original)
+++ Data-ICal/inc/Module/Install/Makefile.pm Mon Aug 15 16:18:30 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/Makefile.pm - /usr/local/share/perl/5.8.4/Module/Install/Makefile.pm"
+#line 1 "inc/Module/Install/Makefile.pm - /Library/Perl/5.8.6/Module/Install/Makefile.pm"
package Module::Install::Makefile;
use Module::Install::Base; @ISA = qw(Module::Install::Base);
Modified: Data-ICal/inc/Module/Install/Metadata.pm
==============================================================================
--- Data-ICal/inc/Module/Install/Metadata.pm (original)
+++ Data-ICal/inc/Module/Install/Metadata.pm Mon Aug 15 16:18:30 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/Metadata.pm - /usr/local/share/perl/5.8.4/Module/Install/Metadata.pm"
+#line 1 "inc/Module/Install/Metadata.pm - /Library/Perl/5.8.6/Module/Install/Metadata.pm"
package Module::Install::Metadata;
use Module::Install::Base; @ISA = qw(Module::Install::Base);
Modified: Data-ICal/inc/Module/Install/Win32.pm
==============================================================================
--- Data-ICal/inc/Module/Install/Win32.pm (original)
+++ Data-ICal/inc/Module/Install/Win32.pm Mon Aug 15 16:18:30 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/Win32.pm - /usr/local/share/perl/5.8.4/Module/Install/Win32.pm"
+#line 1 "inc/Module/Install/Win32.pm - /Library/Perl/5.8.6/Module/Install/Win32.pm"
package Module::Install::Win32;
use Module::Install::Base; @ISA = qw(Module::Install::Base);
Modified: Data-ICal/inc/Module/Install/WriteAll.pm
==============================================================================
--- Data-ICal/inc/Module/Install/WriteAll.pm (original)
+++ Data-ICal/inc/Module/Install/WriteAll.pm Mon Aug 15 16:18:30 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/WriteAll.pm - /usr/local/share/perl/5.8.4/Module/Install/WriteAll.pm"
+#line 1 "inc/Module/Install/WriteAll.pm - /Library/Perl/5.8.6/Module/Install/WriteAll.pm"
package Module::Install::WriteAll;
use Module::Install::Base; @ISA = qw(Module::Install::Base);
Modified: Data-ICal/lib/Data/ICal.pm
==============================================================================
--- Data-ICal/lib/Data/ICal.pm (original)
+++ Data-ICal/lib/Data/ICal.pm Mon Aug 15 16:18:30 2005
@@ -28,7 +28,8 @@
# ... or
- $calendar = Data::ICal->new('foo.ics'); # parse existing file
+ $calendar = Data::ICal->new(filename => 'foo.ics'); # parse existing file
+ $calendar = Data::ICal->new(data => 'BEGIN:VCALENDAR...'); # parse existing file
$calendar->add_entry($vtodo);
@@ -39,8 +40,7 @@
A L<Data::ICal> object represents a C<VCALENDAR> object as defined in the
iCalendar protocol (RFC 2445, MIME type "text/calendar"), as implemented in many
-popular calendaring programs such as Apple's iCal. L<Data::ICal> only provides
-the ability to generate ICal files, not to parse them.
+popular calendaring programs such as Apple's iCal.
Each L<Data::ICal> object is a collection of "entries", which are objects of a
subclass of L<Data::ICal::Entry>. The types of entries defined by iCalendar
@@ -56,15 +56,16 @@
=cut
-=head2 new
+=head2 new [ data => $data, ] [ filename => $file ]
Creates a new L<Data::ICal> object.
-If a file name is passed, this parses that file into the object; otherwise it
-just sets its C<VERSION> and C<PRODID> properties to "2.0" and the value of the
-C<product_id> method respectively.
+If it is given a filename or data argument is passed, then this parses the
+content of the file or string into the object; otherwise it just sets its
+C<VERSION> and C<PRODID> properties to "2.0" and the value of the C<product_id>
+method respectively.
-Returns undef upon failure to open file or parse .ics file.
+Returns undef upon failure to open or parse the file or data.
=cut
@@ -73,7 +74,7 @@
my $self = $class->SUPER::new(@_);
if (@_) {
- $self->parse_file(@_) || return undef;
+ $self->parse(@_) || return;
} else {
$self->add_properties(
version => '2.0',
@@ -83,21 +84,40 @@
return $self;
}
-=head2 parse_file
+=head2 parse [ data => $data, ] [ filename => $file ]
-Parse a .ics file and populate a L<Data::ICal> object.
+Parse a .ics file or string containing one, and populate C<$self> with
+its contents.
+
+Should only be called once on a given object, and will be automatically
+called by C<new> if you provide arguments to C<new>.
=cut
-sub parse_file {
- my ( $self, $file ) = @_;
+sub parse {
+ my $self = shift;
+ my %args = (
+ filename => undef,
+ data => undef,
+ @_);
+
+ return unless defined $args{filename} or defined $args{data};
+
+ my @lines;
+
+ if (defined $args{filename}) {
+ open my $fh, '<', $args{filename} or return;
+ @lines = <$fh>;
+ } else {
+ # This regexp splits after newlines, but keeps them in the string, kind
+ # of like <$fh> does.
+ @lines = split /^/m, $args{data};
+ }
# open the file (checking as we go, like good little Perl mongers)
- open my ($fh), $file or return undef;
- my $cal = Text::vFile::asData->new->parse($fh) || return undef;
- close $fh;
+ my $cal = Text::vFile::asData->new->parse_lines(@lines);
- return undef unless exists $cal->{objects};
+ return unless $cal and exists $cal->{objects};
# loop through all the vcards
foreach my $object ( @{ $cal->{objects} } ) {
Modified: Data-ICal/t/08.parse.t
==============================================================================
--- Data-ICal/t/08.parse.t (original)
+++ Data-ICal/t/08.parse.t Mon Aug 15 16:18:30 2005
@@ -4,7 +4,7 @@
use strict;
use constant TESTS_IN_TEST_CALENDAR => 15;
-use Test::More tests => 6 + 2 * TESTS_IN_TEST_CALENDAR;
+use Test::More tests => 8 + 3 * TESTS_IN_TEST_CALENDAR;
use Test::LongString;
use Test::NoWarnings; # this catches our warnings like setting unknown properties
@@ -12,35 +12,44 @@
-our $s;
-$s = Data::ICal->new('t/ics/nonexistent.ics');
+my $cal;
+$cal = Data::ICal->new(filename => 't/ics/nonexistent.ics');
-is($s, undef, "Caught no file death");
+is($cal, undef, "Caught no file death");
-$s = Data::ICal->new('t/ics/badlyformed.ics');
-is($s, undef, "Caught badly formed ics file death");
+$cal = Data::ICal->new(filename => 't/ics/badlyformed.ics');
+is($cal, undef, "Caught badly formed ics file death");
-$s = Data::ICal->new('t/ics/test.ics');
+$cal = Data::ICal->new(filename => 't/ics/test.ics');
-isa_ok($s, 'Data::ICal');
+isa_ok($cal, 'Data::ICal');
-test_calendar();
+test_calendar($cal);
+
+my $data = $cal->as_string;
+like($data, qr/^BEGIN:VCALENDAR/, "looks like a calendar");
+
+my $roundtripped_from_data_cal = Data::ICal->new(data => $data);
+isa_ok($roundtripped_from_data_cal, 'Data::ICal');
+
+test_calendar($roundtripped_from_data_cal);
SKIP: {
- skip "Can't create t/ics/out.ics: $!", 1 + TESTS_IN_TEST_CALENDAR unless open(ICS,">t/ics/out.ics");
- print ICS $s->as_string;
- close ICS;
+ my $CAL_FILENAME = "t/ics/out.ics";
+ skip "Can't create $CAL_FILENAME: $!", 1 + TESTS_IN_TEST_CALENDAR unless open my $fh,'>', $CAL_FILENAME;
+ print $fh $cal->as_string;
+ close $fh;
- undef($s);
- $s = Data::ICal->new('t/ics/out.ics');
- isa_ok($s, 'Data::ICal');
+ my $roundtripped_cal = Data::ICal->new(filename => $CAL_FILENAME);
+ isa_ok($roundtripped_cal, 'Data::ICal');
- test_calendar();
+ test_calendar($roundtripped_cal);
- unlink('t/ics/out.ics');
+ unlink $CAL_FILENAME;
}
sub test_calendar {
+ my $s = shift;
is($s->ical_entry_type, 'VCALENDAR', "Is a VCALENDAR");
my $id = $s->property('prodid')->[0]->value;
my $name = $s->property('x-wr-calname')->[0]->value;
More information about the Rt-commit
mailing list