package FixedLength;
use strict;
use warnings;
 
 
sub TIESCALAR
{
   my ( $class, $length) = @_;
   my $self = {};
 
   $self->{_item} = undef;
   $self->{_length} = $length;
   return bless \$self, $class;
}
 
sub FETCH
{
   my ($self) = @_;
 
   return $$self->{_item};
}
 
sub STORE
{
   my ( $self, $value ) = @_;
 
   my $len = $$self->{_length};
   $$self->{_item} = pack "A$len", $value;
}
 
1;

##</code><code>##

use FixedLength;
use strict;
 
my $foo;
 
tie $foo, 'FixedLength', 5;
 
my @words = qw( s so som some somew somewo somewor someword somewords);
 
foreach my $word ( @words)
{
   $foo = $word;
   print "*$foo*\n";
}