[Openinteract-commits] CVS: SPOPS/eg/My UTFConvert.pm,NONE,1.1

[Chris W. <la...@us...>]

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