sub random_derangement
{
    my @i = shuffle( 0 .. $#_ );
    my @r;
    @r[ @i ] = @_[ @i[1..$#i], $i[0] ];
    @r
}
[download]

sub derange
{
    my @i = shuffle( 0 .. $#_ );
    @_[ @i ] = @_[ @i[1..$#i], $i[0] ];
}
[download]

Update: I just realized that this is essentially the idea tye suggested in Re^2: Random Derangement Of An Array (rotate). The difference is that I rotate the entire list of (shuffled) indices. I don't believe breaking up the list into smaller chunks is necessary, and, depending on how that was done, could actually hurt the randomization a bit.

Update Again: Upon further reflection, I believe tye is right. In my algorithm above, some derangements are impossible. I had originally had the same idea — subdividing the set of indices — before I (incorrectly, I now believe) made the above oversimplification. The problem is that I don't know how to partition the set fairly. I did come up with an algorithm, but my intuition says it's not exactly fair either. Here it is; perhaps someone can say how fair it is:

sub random_derangement
{
    my @i = shuffle( 0 .. $#_ );
    my @j = @i;

    my @part; # aoa; will contain the partitions
    # distribute the elements of @j across the existing partitions ran
+domly.
    # but if there are N partitions, there is a 1/(N+1) chance that th
+e element
    # will be distributed to a new (N+1)th partition.
    # if the number of existing partitions containing only a single el
+ement
    # is equal to the number of remaining elements of @j, we can't cho
+ose 
    # just any partition; we have to distribute the remaining elements
+ of
    # @j to each of those existing partitions having a single element.
    # furthermore, we take a precaution against getting into a situati
+on
    # where we'll have more "singleton" partitions than we have remain
+ing
    # elements in @j
    while (@j)
    {
        my @d = grep { @$_ == 1 } @part;
        @d = shuffle( @d );
        if ( @d == @j )
        {
            push @{  $d[0]  }, shift @j;
        }
        elsif ( @d+1 >= @j )
        {
            push @{ $part[ rand( @part ) ] }, shift @j;
        }
        else
        {
            push @{ ($part[ rand( 1 + @part ) ]||=[]) }, shift @j;
        }
    }
    # now do the rotations, re-using @i and @j.
    @i=();
    foreach my $part ( @part )
    {
        push @i, @$part;
        push @j, @{$part}[ 1 .. $#{$part}, 0 ];
    }

    my @r;
    @r[ @i ] = @_[ @j ];
    @r
}
[download]