[Rt-commit] r4464 - in Data-ICal: . inc/Module inc/Module/Install
lib/Data lib/Data/ICal
glasser at bestpractical.com
glasser at bestpractical.com
Thu Feb 2 23:56:36 EST 2006
Author: glasser
Date: Thu Feb 2 23:56:34 2006
New Revision: 4464
Added:
Data-ICal/t/09.mime.t
Modified:
Data-ICal/ (props changed)
Data-ICal/META.yml
Data-ICal/Makefile.PL
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/lib/Data/ICal/Property.pm
Log:
r53590 at tin-foil: glasser | 2006-02-02 23:13:25 -0500
Start allowing Quoted-Printable encoding.
Modified: Data-ICal/META.yml
==============================================================================
--- Data-ICal/META.yml (original)
+++ Data-ICal/META.yml Thu Feb 2 23:56:34 2006
@@ -1,19 +1,19 @@
+name: Data-ICal
+version: 0.07
abstract: Generates iCalendar (RFC 2445) calendar files
-author: 'Jesse Vincent <jesse at bestpractical.com>'
+author: Jesse Vincent <jesse at bestpractical.com>
+license: perl
+distribution_type: module
build_requires:
- Test::LongString: 0
Test::More: 0
- Test::NoWarnings: 0
Test::Warn: 0
-distribution_type: module
-generated_by: Module::Install version 0.52
-license: perl
-name: Data-ICal
-no_index:
- directory:
- - inc
- - t
+ Test::NoWarnings: 0
+ Test::LongString: 0
requires:
Class::Accessor: 0
Text::vFile::asData: 0
-version: 0.07
+ MIME::QuotedPrint: 0
+no_index:
+ directory:
+ - inc
+generated_by: Module::Install version 0.46
Modified: Data-ICal/Makefile.PL
==============================================================================
--- Data-ICal/Makefile.PL (original)
+++ Data-ICal/Makefile.PL Thu Feb 2 23:56:34 2006
@@ -11,5 +11,6 @@
build_requires('Test::LongString');
requires('Class::Accessor');
requires('Text::vFile::asData');
+requires('MIME::QuotedPrint');
&WriteAll;
Modified: Data-ICal/inc/Module/Install.pm
==============================================================================
--- Data-ICal/inc/Module/Install.pm (original)
+++ Data-ICal/inc/Module/Install.pm Thu Feb 2 23:56:34 2006
@@ -1,17 +1,10 @@
-#line 1 "/home/jesse/svk/Data-ICal/inc/Module/Install.pm - /usr/local/share/perl/5.8.7/Module/Install.pm"
+#line 1 "/Users/glasser/BestPractical/Data-ICal/inc/Module/Install.pm - /Library/Perl/5.8.6/Module/Install.pm"
package Module::Install;
-
use 5.004;
-use strict 'vars';
-use vars qw{$VERSION};
-BEGIN {
- # Don't forget to update Module::Install::Admin too!
- $VERSION = '0.52';
-}
-# inc::Module::Install must be loaded first
-unless ( $INC{join('/', inc => split(/::/, __PACKAGE__)).'.pm'} ) {
- die <<"END_DIE";
+$VERSION = '0.46';
+
+die << "." unless $INC{join('/', inc => split(/::/, __PACKAGE__)).'.pm'};
Please invoke ${\__PACKAGE__} with:
use inc::${\__PACKAGE__};
@@ -20,28 +13,28 @@
use ${\__PACKAGE__};
-END_DIE
-}
+.
-use Cwd ();
+use strict 'vars';
+use Cwd qw(cwd abs_path);
use FindBin;
use File::Find ();
use File::Path ();
+ at inc::Module::Install::ISA = 'Module::Install';
*inc::Module::Install::VERSION = *VERSION;
- at inc::Module::Install::ISA = 'Module::Install';
sub autoload {
my $self = shift;
my $caller = $self->_caller;
- my $cwd = Cwd::cwd();
- my $sym = "$caller\::AUTOLOAD";
+
+ my $cwd = cwd();
+ my $sym = "$caller\::AUTOLOAD";
$sym->{$cwd} = sub {
- my $pwd = Cwd::cwd();
- if ( my $code = $sym->{$pwd} ) {
- # delegate back to parent dirs
- goto &$code unless $cwd eq $pwd;
+ my $pwd = cwd();
+ if (my $code = $sym->{$pwd}) {
+ goto &$code unless $cwd eq $pwd; # delegate back to parent dirs
}
$$sym =~ /([^:]+)$/ or die "Cannot autoload $caller - $sym";
unshift @_, ($self, $1);
@@ -51,9 +44,9 @@
sub import {
my $class = shift;
- my $self = $class->new(@_);
+ my $self = $class->new(@_);
- unless ( -f $self->{file} ) {
+ if (not -f $self->{file}) {
require "$self->{path}/$self->{dispatch}.pm";
File::Path::mkpath("$self->{prefix}/$self->{author}");
$self->{admin} =
@@ -74,20 +67,19 @@
sub preload {
my ($self) = @_;
- unless ( $self->{extentions} ) {
- $self->load_extensions(
- "$self->{prefix}/$self->{path}", $self
- );
- }
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ ) unless $self->{extensions};
my @exts = @{$self->{extensions}};
- unless ( @exts ) {
+
+ unless (@exts) {
my $admin = $self->{admin};
@exts = $admin->load_all_extensions;
}
my %seen_method;
- foreach my $obj ( @exts ) {
+ foreach my $obj (@exts) {
while (my ($method, $glob) = each %{ref($obj) . '::'}) {
next unless defined *{$glob}{CODE};
next if $method =~ /^_/;
@@ -109,10 +101,8 @@
my ($class, %args) = @_;
# ignore the prefix on extension modules built from top level.
- my $base_path = Cwd::abs_path($FindBin::Bin);
- unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
- delete $args{prefix};
- }
+ my $base_path = abs_path($FindBin::Bin);
+ delete $args{prefix} unless abs_path(cwd()) eq $base_path;
return $args{_self} if $args{_self};
@@ -155,10 +145,10 @@
return $obj if $obj->can($method);
}
- my $admin = $self->{admin} or die <<"END_DIE";
+ my $admin = $self->{admin} or die << "END";
The '$method' method does not exist in the '$self->{prefix}' path!
Please remove the '$self->{prefix}' directory and run $0 again to load it.
-END_DIE
+END
my $obj = $admin->load($method, 1);
push @{$self->{extensions}}, $obj;
@@ -179,10 +169,7 @@
local $@;
my $new = eval { require $file; $pkg->can('new') };
- unless ( $new ) {
- warn $@ if $@;
- next;
- }
+ if (!$new) { warn $@ if $@; next; }
$self->{pathnames}{$pkg} = delete $INC{$file};
push @{$self->{extensions}}, &{$new}($pkg, _top => $top_obj );
}
@@ -192,23 +179,23 @@
sub find_extensions {
my ($self, $path) = @_;
-
my @found;
- File::Find::find( sub {
+
+ File::Find::find(sub {
my $file = $File::Find::name;
return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
return if $1 eq $self->{dispatch};
$file = "$self->{path}/$1.pm";
my $pkg = "$self->{name}::$1"; $pkg =~ s!/!::!g;
- push @found, [ $file, $pkg ];
- }, $path ) if -d $path;
+ push @found, [$file, $pkg];
+ }, $path) if -d $path;
@found;
}
sub _caller {
- my $depth = 0;
+ my $depth = 0;
my $caller = caller($depth);
while ($caller eq __PACKAGE__) {
Modified: Data-ICal/inc/Module/Install/Base.pm
==============================================================================
--- Data-ICal/inc/Module/Install/Base.pm (original)
+++ Data-ICal/inc/Module/Install/Base.pm Thu Feb 2 23:56:34 2006
@@ -1,10 +1,10 @@
-#line 1 "inc/Module/Install/Base.pm - /usr/local/share/perl/5.8.7/Module/Install/Base.pm"
+#line 1 "inc/Module/Install/Base.pm - /Library/Perl/5.8.6/Module/Install/Base.pm"
package Module::Install::Base;
# Suspend handler for "redefined" warnings
BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w } };
-#line 30
+#line 31
sub new {
my ($class, %args) = @_;
@@ -18,21 +18,18 @@
bless(\%args, $class);
}
-#line 48
+#line 49
sub AUTOLOAD {
my $self = shift;
-
- local $@;
- my $autoload = eval { $self->_top->autoload } or return;
- goto &$autoload;
+ goto &{$self->_top->autoload};
}
-#line 62
+#line 60
sub _top { $_[0]->{_top} }
-#line 73
+#line 71
sub admin {
my $self = shift;
@@ -60,4 +57,4 @@
__END__
-#line 120
+#line 118
Modified: Data-ICal/inc/Module/Install/Can.pm
==============================================================================
--- Data-ICal/inc/Module/Install/Can.pm (original)
+++ Data-ICal/inc/Module/Install/Can.pm Thu Feb 2 23:56:34 2006
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/Can.pm - /usr/local/share/perl/5.8.7/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';
@@ -52,7 +52,6 @@
# Fix Cygwin bug on maybe_command();
if ($^O eq 'cygwin') {
require ExtUtils::MM_Cygwin;
- require ExtUtils::MM_Win32;
if (!defined(&ExtUtils::MM_Cygwin::maybe_command)) {
*ExtUtils::MM_Cygwin::maybe_command = sub {
my ($self, $file) = @_;
Modified: Data-ICal/inc/Module/Install/Fetch.pm
==============================================================================
--- Data-ICal/inc/Module/Install/Fetch.pm (original)
+++ Data-ICal/inc/Module/Install/Fetch.pm Thu Feb 2 23:56:34 2006
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/Fetch.pm - /usr/local/share/perl/5.8.7/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 Thu Feb 2 23:56:34 2006
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/Makefile.pm - /usr/local/share/perl/5.8.7/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);
@@ -65,14 +65,14 @@
$args->{test} = {TESTS => $self->tests} if $self->tests;
if ($] >= 5.005) {
- $args->{ABSTRACT} = $self->abstract;
- $args->{AUTHOR} = $self->author;
+ $args->{ABSTRACT} = $self->abstract;
+ $args->{AUTHOR} = $self->author;
}
if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) {
$args->{NO_META} = 1;
}
if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 ) {
- $args->{SIGN} = 1 if $self->sign;
+ $args->{SIGN} = 1 if $self->sign;
}
delete $args->{SIGN} unless $self->is_admin;
@@ -154,4 +154,4 @@
__END__
-#line 286
+#line 287
Modified: Data-ICal/inc/Module/Install/Metadata.pm
==============================================================================
--- Data-ICal/inc/Module/Install/Metadata.pm (original)
+++ Data-ICal/inc/Module/Install/Metadata.pm Thu Feb 2 23:56:34 2006
@@ -1,41 +1,42 @@
-#line 1 "inc/Module/Install/Metadata.pm - /usr/local/share/perl/5.8.7/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;
+ at ISA = qw(Module::Install::Base);
+
+$VERSION = '0.04';
use strict 'vars';
-use Module::Install::Base;
+use vars qw($VERSION);
-use vars qw($VERSION @ISA);
-BEGIN {
- $VERSION = '0.06';
- @ISA = 'Module::Install::Base';
-}
+sub Meta { shift }
-my @scalar_keys = qw{
- name module_name abstract author version license
+my @scalar_keys = qw<
+ name module_name version abstract author license
distribution_type perl_version tests
-};
-
-my @tuple_keys = qw{
+>;
+my @tuple_keys = qw<
build_requires requires recommends bundles
-};
-
-sub Meta { shift }
-sub Meta_ScalarKeys { @scalar_keys }
-sub Meta_TupleKeys { @tuple_keys }
+>;
foreach my $key (@scalar_keys) {
*$key = sub {
my $self = shift;
- return $self->{values}{$key} if defined wantarray and !@_;
- $self->{values}{$key} = shift;
+ return $self->{'values'}{$key} unless @_;
+ $self->{'values'}{$key} = shift;
return $self;
};
}
+sub sign {
+ my $self = shift;
+ $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 );
+ return $self;
+}
+
foreach my $key (@tuple_keys) {
*$key = sub {
my $self = shift;
- return $self->{values}{$key} unless @_;
+ return $self->{'values'}{$key} unless @_;
my @rv;
while (@_) {
@@ -50,29 +51,14 @@
my $rv = [ $module, $version ];
push @rv, $rv;
}
- push @{ $self->{values}{$key} }, @rv;
+ push @{ $self->{'values'}{$key} }, @rv;
@rv;
};
}
-sub sign {
- my $self = shift;
- return $self->{'values'}{'sign'} if defined wantarray and !@_;
- $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 );
- return $self;
-}
-
sub all_from {
my ( $self, $file ) = @_;
- unless ( defined($file) ) {
- my $name = $self->name
- or die "all_from called with no args without setting name() first";
- $file = join('/', 'lib', split(/-/, $name)) . '.pm';
- $file =~ s{.*/}{} unless -e $file;
- die "all_from: cannot find $file from $name" unless -e $file;
- }
-
$self->version_from($file) unless $self->version;
$self->perl_version_from($file) unless $self->perl_version;
@@ -90,7 +76,7 @@
sub provides {
my $self = shift;
- my $provides = ( $self->{values}{provides} ||= {} );
+ my $provides = ( $self->{'values'}{'provides'} ||= {} );
%$provides = (%$provides, @_) if @_;
return $provides;
}
@@ -104,12 +90,6 @@
return $self;
}
- # Avoid spurious warnings as we are not checking manifest here.
-
- local $SIG{__WARN__} = sub {1};
- require ExtUtils::Manifest;
- local *ExtUtils::Manifest::manicheck = sub { return };
-
require Module::Build;
my $build = Module::Build->new(
dist_name => $self->{name},
@@ -122,7 +102,7 @@
sub feature {
my $self = shift;
my $name = shift;
- my $features = ( $self->{values}{features} ||= [] );
+ my $features = ( $self->{'values'}{'features'} ||= [] );
my $mods;
@@ -154,14 +134,84 @@
while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
$self->feature( $name, @$mods );
}
- return @{ $self->{values}{features} };
+ return @{ $self->{'values'}{'features'} };
}
sub no_index {
my $self = shift;
my $type = shift;
- push @{ $self->{values}{no_index}{$type} }, @_ if $type;
- return $self->{values}{no_index};
+ push @{ $self->{'values'}{'no_index'}{$type} }, @_ if $type;
+ return $self->{'values'}{'no_index'};
+}
+
+sub _dump {
+ my $self = shift;
+ my $package = ref( $self->_top );
+ my $version = $self->_top->VERSION;
+ my %values = %{ $self->{'values'} };
+
+ delete $values{sign};
+ if ( my $perl_version = delete $values{perl_version} ) {
+
+ # Always canonical to three-dot version
+ $perl_version =~
+ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2), int($3))}e
+ if $perl_version >= 5.006;
+ $values{requires} =
+ [ [ perl => $perl_version ], @{ $values{requires} || [] }, ];
+ }
+
+ warn "No license specified, setting license = 'unknown'\n"
+ unless $values{license};
+
+ $values{license} ||= 'unknown';
+ $values{distribution_type} ||= 'module';
+ $values{name} ||= do {
+ my $name = $values{module_name};
+ $name =~ s/::/-/g;
+ $name;
+ } if $values{module_name};
+
+ if ( $values{name} =~ /::/ ) {
+ my $name = $values{name};
+ $name =~ s/::/-/g;
+ die "Error in name(): '$values{name}' should be '$name'!\n";
+ }
+
+ my $dump = '';
+ foreach my $key (@scalar_keys) {
+ $dump .= "$key: $values{$key}\n" if exists $values{$key};
+ }
+ foreach my $key (@tuple_keys) {
+ next unless exists $values{$key};
+ $dump .= "$key:\n";
+ foreach ( @{ $values{$key} } ) {
+ $dump .= " $_->[0]: $_->[1]\n";
+ }
+ }
+
+ if ( my $provides = $values{provides} ) {
+ require YAML;
+ local $YAML::UseHeader = 0;
+ $dump .= YAML::Dump( { provides => $provides } );
+ }
+
+ if ( my $no_index = $values{no_index} ) {
+ push @{ $no_index->{'directory'} }, 'inc';
+ require YAML;
+ local $YAML::UseHeader = 0;
+ $dump .= YAML::Dump( { no_index => $no_index } );
+ }
+ else {
+ $dump .= << "META";
+no_index:
+ directory:
+ - inc
+META
+ }
+
+ $dump .= "generated_by: $package version $version\n";
+ return $dump;
}
sub read {
@@ -189,7 +239,24 @@
sub write {
my $self = shift;
return $self unless $self->is_admin;
- $self->admin->write_meta;
+
+ META_NOT_OURS: {
+ local *FH;
+ if ( open FH, "META.yml" ) {
+ while (<FH>) {
+ last META_NOT_OURS if /^generated_by: Module::Install\b/;
+ }
+ return $self if -s FH;
+ }
+ }
+
+ print "Writing META.yml\n";
+
+ local *META;
+ open META, "> META.yml" or warn "Cannot write to META.yml: $!";
+ print META $self->_dump;
+ close META;
+
return $self;
}
@@ -203,11 +270,8 @@
my ( $self, $file ) = @_;
require ExtUtils::MM_Unix;
$self->abstract(
- bless(
- { DISTNAME => $self->name },
- 'ExtUtils::MM_Unix'
- )->parse_abstract($file)
- );
+ bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )
+ ->parse_abstract($file) );
}
sub _slurp {
Modified: Data-ICal/inc/Module/Install/Win32.pm
==============================================================================
--- Data-ICal/inc/Module/Install/Win32.pm (original)
+++ Data-ICal/inc/Module/Install/Win32.pm Thu Feb 2 23:56:34 2006
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/Win32.pm - /usr/local/share/perl/5.8.7/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 Thu Feb 2 23:56:34 2006
@@ -1,13 +1,13 @@
-#line 1 "inc/Module/Install/WriteAll.pm - /usr/local/share/perl/5.8.7/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);
sub WriteAll {
my $self = shift;
my %args = (
- meta => 1,
- sign => 0,
- inline => 0,
+ meta => 1,
+ sign => 0,
+ inline => 0,
check_nmake => 1,
@_
);
@@ -17,10 +17,10 @@
$self->admin->WriteAll(%args) if $self->is_admin;
if ($0 =~ /Build.PL$/i) {
- $self->Build->write;
+ $self->Build->write;
}
else {
- $self->check_nmake if $args{check_nmake};
+ $self->check_nmake if $args{check_nmake};
$self->makemaker_args( PL_FILES => {} )
unless $self->makemaker_args->{'PL_FILES'};
Modified: Data-ICal/lib/Data/ICal.pm
==============================================================================
--- Data-ICal/lib/Data/ICal.pm (original)
+++ Data-ICal/lib/Data/ICal.pm Thu Feb 2 23:56:34 2006
@@ -206,8 +206,7 @@
L<Data::ICal> does not check to see if nested entries are nested properly (alarms in
todos and events only, everything else in calendars only).
-L<Data::ICal> has no automatic support for converting binary data to the appropriate
-encoding and setting the corresponding parameters.
+The only property encoding supported by L<Data::ICal> is quoted printable.
There is no L<Data::ICal::Entry::Alarm> base class.
Modified: Data-ICal/lib/Data/ICal/Property.pm
==============================================================================
--- Data-ICal/lib/Data/ICal/Property.pm (original)
+++ Data-ICal/lib/Data/ICal/Property.pm Thu Feb 2 23:56:34 2006
@@ -6,6 +6,7 @@
use base qw/Class::Accessor/;
use Carp;
+use MIME::QuotedPrint ();
our $VERSION = '0.06';
@@ -17,11 +18,17 @@
=head1 DESCRIPTION
A L<Data::ICal::Property> object represents a single property on an
-entry in an iCalendar file.
+entry in an iCalendar file. Properties have parameters in addition to their value.
-You shouldn't need to access L<Data::ICal::Property> values directly -- just use
+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<set_value_with_encoding> 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
@@ -62,10 +69,71 @@
=head2 parameters [$param_hash]
Gets or sets the parameter hash reference of this property.
+Parameter keys are converted to upper case.
+
+=cut
+
+__PACKAGE__->mk_accessors(qw(key value _parameters));
+
+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 => \&MIME::QuotedPrint::encode,
+ decode => \&MIME::QuotedPrint::decode },
+);
+
+=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
-__PACKAGE__->mk_accessors(qw(key value parameters));
+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 set_value_with_encoding $decoded_value, $encoding
+
+Encodes C<$decoded_value> in the encoding C<$encoding>; sets the value to the encoded
+value and the encoding parameter to C<$encoding>. Does nothing if the encoding is not
+recognized.
+
+=cut
+
+sub set_value_with_encoding {
+ my $self = shift;
+ my $decoded_value = shift;
+ my $encoding = uc shift;
+
+ if ($ENCODINGS{$encoding}) {
+ $self->value( $ENCODINGS{$encoding}{'encode'}->($decoded_value) );
+ $self->parameters->{'ENCODING'} = $encoding;
+ }
+}
=head2 as_string
@@ -128,7 +196,7 @@
for my $name ( sort keys %{ $self->parameters } ) {
my $value = $self->parameters->{$name};
$out .= ';'
- . uc($name) . '='
+ . $name . '='
. $self->_quoted_parameter_values(
ref $value ? @$value : $value );
}
Added: Data-ICal/t/09.mime.t
==============================================================================
--- (empty file)
+++ Data-ICal/t/09.mime.t Thu Feb 2 23:56:34 2006
@@ -0,0 +1,44 @@
+#!/usr/bin/perl -w
+
+use warnings;
+use strict;
+
+use Test::More tests => 4;
+use Test::LongString;
+use Test::NoWarnings;
+
+BEGIN { use_ok('Data::ICal') }
+
+my $cal = Data::ICal->new(data => <<'END_VCAL');
+BEGIN:VCALENDAR
+BEGIN:VTODO
+DESCRIPTION;ENCODING=QUOTED-PRINTABLE:interesting things =0D=0A
+ Yeah!!=3D =63bla=0D=0A=0D=0A=0D=0AGo team syncml!=0D=0A=0D=0A=0D=0A
+END:VTODO
+END:VCALENDAR
+END_VCAL
+
+isa_ok($cal, 'Data::ICal');
+
+is_string($cal->entries->[0]->property("description")->[0]->decoded_value, <<"END_DESC");
+interesting things \r
+Yeah!!= cbla\r
+\r
+\r
+Go team syncml!\r
+\r
+\r
+END_DESC
+
+
+__END__
+DESCRIPTION;ENCODING=QUOTED-PRINTABLE;CHARSET=UTF-8:interesting thi=
+ngs =0D=0A=
+Yeah!!=3D =C3=AAtre=0D=0A=
+=0D=0A=
+=0D=0A=
+Go team syncml!=0D=0A=
+=0D=0A=
+=0D=0A=
+END_DESC
+
More information about the Rt-commit
mailing list