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

use warnings;
use strict;

package Data::ICal::Property;

use base qw/Class::Accessor/;

use Carp;
use MIME::QuotedPrint ();

our $VERSION = '0.06';

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

    bless $self, $class;

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

__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;
            }
    },
);

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;
    }
}

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;
    }
}

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} );
    } else {
        return $string;
    }
}

sub _value_as_string {
    my $self  = shift;
    my $key   = shift;
    my $value = defined( $self->value() ) ? $self->value() : '';

    unless ( $self->vcal10 ) {
        $value =~ s/\\/\\\\/gs;
        $value =~ s/;/\\;/gs unless lc($key) eq 'rrule';
        $value =~ s/,/\\,/gs unless lc($key) eq 'rrule';
        $value =~ s/\x0d?\x0a/\\n/gs;
    }

    return $value;

}

sub _parameters_as_string {
    my $self = shift;
    my $out  = '';
    for my $name ( sort keys %{ $self->parameters } ) {
        my $value = $self->parameters->{$name};
        $out
            .= ';'
            . $name . '='
            . $self->_quoted_parameter_values(
            ref $value ? @$value : $value );
    }
    return $out;
}

sub _quoted_parameter_values {
    my $self   = shift;
    my @values = @_;

    for my $val (@values) {
        if ( $val =~ /"/ ) {

            # Get all the way back to the user's code
            local $Carp::CarpLevel = $Carp::CarpLevel + 1;
            carp "Invalid parameter value (contains double quote): $val";
            $val =~ tr/"//d;
        }
    }

    return join ',', map { /[;,:]/ ? qq("$_") : $_ } @values;
}

sub _fold {
    my $self   = shift;
    my $string = shift;
    my $crlf   = shift;

    my $quoted_printable = $self->vcal10
        && uc( $self->parameters->{'ENCODING'} || '' ) eq 'QUOTED-PRINTABLE';

    if ($quoted_printable) {

     # In old vcal, quoted-printable properties have different folding rules.
     # But some interop tests suggest it's wiser just to not fold for vcal 1.0
     # at all (in quoted-printable).
    } else {
        my $pos = 0;

        # Walk through the value, looking to replace 75 characters at
        # a time.  We assign to pos() to update where to pick up for
        # the next match.
        while ( $string =~ s/\G(.{75})(?=.)/$1$crlf / ) {
            $pos += 75 + length($crlf);
            pos($string) = $pos;
        }
    }

    return $string;
}

1;