view release on metacpan or  search on metacpan

lib/Data/ICal/Property.pm  view on Meta::CPAN

use warnings;
use strict;

package Data::ICal::Property;

use base qw/Class::Accessor/;

use Carp;
use MIME::QuotedPrint ();

our $VERSION = '0.06';

=head1 NAME

Data::ICal::Property - Represents a property on an entry in an iCalendar file

=head1 DESCRIPTION

A L<Data::ICal::Property> object represents a single property on an
entry in an iCalendar file.  Properties have parameters in addition to
their value.

You shouldn't need to create L<Data::ICal::Property> values directly
-- just use C<add_property> in L<Data::ICal::Entry>.

The C<encoding> parameter value is only interpreted by L<Data::ICal>
in the C<decoded_value> and C<encode> methods: all other methods
access the encoded version directly (if there is an encoding).

Currently, the only supported encoding is C<QUOTED-PRINTABLE>.

=head1 METHODS

=cut

=head2 new $key, $value, [$parameter_hash]

Creates a new L<Data::ICal::Property> with key C<$key> and value C<$value>.

If C<$parameter_hash> is provided, sets the property's parameters to
it.  The parameter hash should have keys equal to the names of the
parameters (case insensitive; parameter hashes should not contain two
different keys which are the same when converted to upper case); the
values should either be a string if the parameter has a single value
or an array reference of strings if the parameter has multiple values.

=cut

sub new {
    my $class = shift;
    my $self  = {};

    bless $self, $class;

    $self->key(shift);
    $self->value(shift);
    $self->parameters( shift || {} );
    return ($self);
}

=head2 key [$key]

Gets or sets the key name of this property.

=head2 value [$value]

Gets or sets the value of this property.

=head2 parameters [$param_hash]

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 vcal10));

sub parameters {
    my $self = shift;

    if (@_) {
        my $params     = shift;
        my $new_params = {};
        while ( my ( $k, $v ) = each %$params ) {
            $new_params->{ uc $k } = $v;
        }
        $self->_parameters($new_params);
    }

    return $self->_parameters;
}

my %ENCODINGS = (
    'QUOTED-PRINTABLE' => {
        encode => sub {
            my $dec = shift || '';
            $dec =~ s/\n/\r\n/g;
            return MIME::QuotedPrint::encode( $dec, '' );
        },
        decode => sub {
            my $dec = MIME::QuotedPrint::decode( shift || '' );
            $dec =~ s/\r\n/\n/g;
            return $dec;
            }
    },
);

=head2 decoded_value

Gets the value of this property, converted from the encoding specified
in its encoding parameter.  (That is, C<value> will return the encoded
version; this will apply the encoding.)  If the encoding is not
specified or recognized, just returns the raw value.

=cut

sub decoded_value {
    my $self     = shift;
    my $value    = $self->value;
    my $encoding = uc( $self->parameters->{'ENCODING'} || "" );

    if ( $ENCODINGS{$encoding} ) {
        return $ENCODINGS{$encoding}{'decode'}->($value);
    } else {
        return $value;
    }
}

=head2 encode $encoding

Calls C<decoded_value> to get the current decoded value, then encodes
it in C<$encoding>, sets the value to that, and sets the encoding
parameter to C<$encoding>. (C<$encoding> is first converted to upper
case.)

If C<$encoding> is undef, deletes the encoding parameter and sets the
value to the decoded value.  Does nothing if the encoding is not
recognized.

=cut

sub encode {
    my $self     = shift;
    my $encoding = uc shift;

    my $decoded_value = $self->decoded_value;

    if ( not defined $encoding ) {
        $self->value($decoded_value);
        delete $self->parameters->{'ENCODING'};
    } elsif ( $ENCODINGS{$encoding} ) {
        $self->value( $ENCODINGS{$encoding}{'encode'}->($decoded_value) );
        $self->parameters->{'ENCODING'} = $encoding;
    }
    return $self;
}

=head2 as_string ARGS

Returns the property formatted as a string (including trailing
newline).

Takes named arguments:

=over

=item fold

Defaults to true. pass in a false value if you need to generate
non-rfc-compliant calendars.

=item crlf

Defaults to C<\x0d\x0a>, per RFC 2445 spec.  This option is primarily
for backwards compatibility with version of this module prior to 0.16,
which used C<\x0a>.

=back

=cut

sub as_string {
    my $self = shift;
    my %args = (
        fold => 1,
        crlf => Data::ICal::Entry->CRLF,
        @_
    );
    my $string
        = uc( $self->key )
        . $self->_parameters_as_string . ":"
        . $self->_value_as_string( $self->key )
        . $args{crlf};

  # Assumption: the only place in an iCalendar that needs folding are property
  # lines
    if ( $args{'fold'} ) {
        return $self->_fold( $string, $args{crlf} );
    }

    return $string;
}

=begin private

=head2 _value_as_string

Returns the property's value as a string.  Comma and semicolon are not
escaped when the value is recur type (the key is rrule).

Values are quoted according the iCal spec, unless this is in vCal 1.0
mode.