|
From: Chris W. <la...@us...> - 2001-11-25 01:02:40
|
Update of /cvsroot/openinteract/SPOPS/eg/My
In directory usw-pr-cvs1:/tmp/cvs-serv854/My
Added Files:
UTFConvert.pm
Log Message:
added sample rules to convert to/from unicode data -- ONLY INCLUDED
FOR DEMONSTRATION PURPOSES!
--- NEW FILE: UTFConvert.pm ---
package My::UTFConvert;
# $Id: UTFConvert.pm,v 1.1 2001/11/25 01:02:34 lachoy Exp $
# WARNING: This currently only works in 5.6.0 and earlier versions of
# Perl. It will barf with a syntax error on later versions.
use strict;
use utf8;
use SPOPS qw( _w DEBUG );
sub ruleset_factory {
my ( $class, $ruleset ) = @_;
DEBUG && _w( 1, "Installing UTF8 conversion methods for ($class)" );
push @{ $ruleset->{post_fetch_action} }, \&from_utf;
push @{ $ruleset->{pre_save_action} }, \&to_utf;
}
sub from_utf {
my ( $self ) = @_;
my $convert_fields = $self->CONFIG->{utf_fields};
return 1 unless ( ref $convert_fields eq 'ARRAY' and
scalar @{ $convert_fields } );
foreach my $field ( @{ $convert_fields } ) {
$self->{ $field } =~ tr/\0-\x{FF}//UC;
}
return 1;
}
sub to_utf {
my ( $self ) = @_;
my $convert_fields = $self->CONFIG->{utf_fields};
return 1 unless ( ref $convert_fields eq 'ARRAY' and
scalar @{ $convert_fields } );
foreach my $field ( @{ $convert_fields } ) {
$self->{ $field } =~ tr/\0-\x{FF}//CU;
}
return 1;
}
1;
__END__
=pod
=head1 NAME
My::UTFConvert -- Provide automatic UTF-8 conversion
=head1 SYNOPSIS
# In object configuration
object => {
rules_from => [ 'My::UTFConvert' ],
utf_fields => [ 'field1', 'field2' ],
},
=head1 WARNING
This currently only works in 5.6.0 and earlier versions of Perl. It
will barf with a syntax error on later versions.
=head1 DESCRIPTION
Provides translation from/to unicode datasources via UTF8. When an
object is fetched we do a translation on the fields specified in
'utf_fields' of the object configuration, and before an object is
saved we do a translation on those same fields.
=head1 METHODS
B<from_utf>
B<to_utf>
=head1 BUGS
None known.
=head1 TO DO
Nothing known.
=head1 SEE ALSO
L<utf8>
L<perlunicode>
=head1 COPYRIGHT
Copyright (c) 2001 Chris Winters. All rights reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 AUTHORS
Chris Winters <ch...@cw...>
Andreas Nolte <and...@be...>
=cut
|