[Rt-commit] r4467 - in Data-ICal: . lib/Data/ICal t

glasser at bestpractical.com glasser at bestpractical.com
Fri Feb 3 12:26:29 EST 2006


Author: glasser
Date: Fri Feb  3 12:26:28 2006
New Revision: 4467

Modified:
   Data-ICal/   (props changed)
   Data-ICal/Makefile.PL
   Data-ICal/lib/Data/ICal.pm
   Data-ICal/lib/Data/ICal/Entry.pm
   Data-ICal/lib/Data/ICal/Property.pm
   Data-ICal/t/08.parse.t

Log:
 r53601 at david-glassers-powerbook-g4-15:  glasser | 2006-02-03 12:24:29 -0500
  * propogate vcal10 down to properties.
  * Use Class::ReturnValue for error messages from Data::ICal->new.


Modified: Data-ICal/Makefile.PL
==============================================================================
--- Data-ICal/Makefile.PL	(original)
+++ Data-ICal/Makefile.PL	Fri Feb  3 12:26:28 2006
@@ -12,5 +12,6 @@
 requires('Class::Accessor');
 requires('Text::vFile::asData');
 requires('MIME::QuotedPrint');
+requires('Class::ReturnValue');
 
 &WriteAll;

Modified: Data-ICal/lib/Data/ICal.pm
==============================================================================
--- Data-ICal/lib/Data/ICal.pm	(original)
+++ Data-ICal/lib/Data/ICal.pm	Fri Feb  3 12:26:28 2006
@@ -4,6 +4,8 @@
 package Data::ICal;
 use base qw/Data::ICal::Entry/;
 
+use Class::ReturnValue;
+
 use Text::vFile::asData;
 
 our $VERSION = '0.07';
@@ -69,7 +71,9 @@
 C<PRODID> properties to "2.0" (or "1.0" if the C<vcal10> flag is passed) and
 the value of the C<product_id> method respectively.
 
-Returns undef upon failure to open or parse the file or data.
+Returns a false value upon failure to open or parse the file or data; this false
+value is a L<Class::ReturnValue> object and can be queried as to its 
+C<error_message>.
 
 =cut
 
@@ -87,17 +91,18 @@
     $self->vcal10($args{vcal10});
 
     if (defined $args{filename} or defined $args{data}) {
-        $self->parse(%args) || return;
+        # might return a Class::ReturnValue if parsing fails
+        return $self->parse(%args);
     } else {
         $self->add_properties(
             version => ($self->vcal10 ? '1.0' : '2.0'),
             prodid  => $self->product_id,
         );
+        return $self;
     }
-    return $self;
 }
 
-=head2 parse [ data => $data, ] [ filename => $file ]
+=head2 parse [ data => $data, ] [ filename => $file, ]
 
 Parse a .ics file or string containing one, and populate C<$self> with
 its contents.
@@ -105,6 +110,11 @@
 Should only be called once on a given object, and will be automatically
 called by C<new> if you provide arguments to C<new>.
 
+Returns C<$self> on success.
+Returns a false value upon failure to open or parse the file or data; this false
+value is a L<Class::ReturnValue> object and can be queried as to its 
+C<error_message>.
+
 =cut
 
 sub parse {
@@ -115,13 +125,16 @@
         @_
     );
 
-    return unless defined $args{filename} or defined $args{data};
+    unless (defined $args{filename} or defined $args{data}) {
+        return $self->_error("parse called with no filename or data specified");
+    } 
 
     my @lines;
 
     # open the file (checking as we go, like good little Perl mongers)
     if ( defined $args{filename} ) {
-        open my $fh, '<', $args{filename} or return;
+        open my $fh, '<', $args{filename} or 
+            return $self->_error("could not open '$args{filename}': $!");
         @lines = map {chomp; $_} <$fh>;
     } else {
         @lines = split /\n/, $args{data};
@@ -130,15 +143,33 @@
     # Parse the lines; Text::vFile doesn't want trailing newlines
     my $cal = Text::vFile::asData->new->parse_lines(@lines);
 
-    return unless $cal and exists $cal->{objects};
+    return $self->_error("parse failure") unless $cal and exists $cal->{objects};
 
     # loop through all the vcards
     foreach my $object ( @{ $cal->{objects} } ) {
         $self->parse_object($object);
     }
-    return 1;
+
+    my $version = $self->property("version")->[0]->value;
+    if ($version eq '1.0' and not $self->vcal10 or
+        $version eq '2.0' and $self->vcal10) {
+        return $self->_error('application claims data is' .
+                    ($self->vcal10 ? '' : ' not') . ' vCal 1.0 but doc contains VERSION:' .
+                    $version);
+    } 
+    
+    return $self;
 }
 
+sub _error {
+    my $self = shift;
+    my $msg  = shift;
+    
+    my $ret = Class::ReturnValue->new;
+    $ret->as_error(errno => 1, message => $msg);
+    return $ret;
+} 
+
 =head2 ical_entry_type
 
 Returns C<VCALENDAR>, its iCalendar entry name.

Modified: Data-ICal/lib/Data/ICal/Entry.pm
==============================================================================
--- Data-ICal/lib/Data/ICal/Entry.pm	(original)
+++ Data-ICal/lib/Data/ICal/Entry.pm	Fri Feb  3 12:26:28 2006
@@ -188,8 +188,10 @@
 
     my ( $prop_value, $param_hash ) = @$val;
 
-    push @{ $self->properties->{$prop} },
-        Data::ICal::Property->new( $prop => $prop_value, $param_hash );
+    my $p = Data::ICal::Property->new( $prop => $prop_value, $param_hash );
+    $p->vcal10( $self-> vcal10 );
+    
+    push @{ $self->properties->{$prop} }, $p;
 }
 
 =head2 add_properties $propname1 => $propval1, [$propname2 => $propname2, ...]

Modified: Data-ICal/lib/Data/ICal/Property.pm
==============================================================================
--- Data-ICal/lib/Data/ICal/Property.pm	(original)
+++ Data-ICal/lib/Data/ICal/Property.pm	Fri Feb  3 12:26:28 2006
@@ -71,9 +71,18 @@
 Gets or sets the parameter hash reference of this property.
 Parameter keys are converted to upper case.
 
+=head2 vcal10 [$bool]
+
+Gets or sets a boolean saying whether this should be interpreted as vCalendar
+1.0 (as opposed to iCalendar 2.0).  Generally, you can just set this on your
+main L<Data::ICal> object when you construct it; C<add_entry> automatically makes
+sure that sub-entries end up with the same value as their parents, and 
+C<add_property> makes sure that properties end up with the same value as
+their entry.
+
 =cut
 
-__PACKAGE__->mk_accessors(qw(key value _parameters));
+__PACKAGE__->mk_accessors(qw(key value _parameters vcal10));
 
 sub parameters {
     my $self = shift;

Modified: Data-ICal/t/08.parse.t
==============================================================================
--- Data-ICal/t/08.parse.t	(original)
+++ Data-ICal/t/08.parse.t	Fri Feb  3 12:26:28 2006
@@ -15,10 +15,10 @@
 my $cal;
 $cal = Data::ICal->new(filename => 't/ics/nonexistent.ics');
 
-ok((not defined $cal), "Caught no file death");
+ok((not $cal), "Caught no file death");
 
 $cal = Data::ICal->new(filename => 't/ics/badlyformed.ics'); 
-ok((not defined $cal), "Caught badly formed ics file death"); 
+ok((not $cal), "Caught badly formed ics file death"); 
 
 $cal = Data::ICal->new(filename => 't/ics/test.ics');
 


More information about the Rt-commit mailing list