sub permute {
  my @items = @_;
  my $n = 0;
  return sub {
    $n++, return @items if $n==0;
    my $i;
    my $p = $n;
    for ($i=1; $i<=@items && $p%$i==0; $i++) {
      $p /= $i;
    }
    my $d = $p % $i;
    my $j = @items - $i;
    return if $j < 0;

    @items[$j+1..$#items] = reverse @items[$j+1..$#items];
    @items[$j,$j+$d] = @items[$j+$d,$j];

    $n++;
    return @items;
  }
}

##</code><code>##

  15 = 2*3! + 1*2! + 1*1!

##</code><code>##

sub fb_to_perm {
  my @arr = @{ shift() };
  my $fb = shift;
  return unless defined $fb;
  my @ret;
  push @ret, splice @arr, $_, 1 for @$fb;
  push @ret, @arr;
  return @ret;
}

##</code><code>##

my $n = 0;
{
  my $fb = n_to_fb( $n, scalar @my_list );
  last unless $fb;
  my @perm = fb_to_perm( \@my_list, $fb );
  print "@perm\n";
  ++$n;
  redo;
}

##</code><code>##

A B C D 000_F   B A C D 100_F   C A B D 200_F   D A B C 300_F
A B D C 001_F   B A D C 101_F   C A D B 201_F   D A C B 301_F
A C B D 010_F   B C A D 110_F   C B A D 210_F   D B A C 310_F
A C D B 011_F   B C D A 111_F   C B D A 211_F   D B C A 311_F
A D B C 020_F   B D A C 120_F   C D A B 220_F   D C A B 320_F
A D C B 021_F   B D C A 121_F   C D B A 221_F   D C B A 321_F

##</code><code>##

A B C D 000_F

A D C B 021_F
B A C D 100_F

B D C A 121_F
C A B D 200_F

C D B A 221_F
D A B C 300_F

##</code><code>##

A B C D 000_F
A C B D 010_F
A D B C 020_F

B A C D 100_F
B C A D 110_F
B D A C 120_F

C A B D 200_F
C B A D 210_F
C D A B 220_F

D A B C 300_F
D B A C 310_F
D C A B 320_F

##</code><code>##

sub offsets {
  my $p = $_[ 0 ];
  my $i = 2;
  my $d;
  $p /= $i++ until $d = $p % $i;

  return ( $i, $d );
}

##</code><code>##

sub perms {
  my @arr = @_;
  my $m = @arr;
  my $n = 0;
  {
    print "@arr\n";
    ++$n;
    my ( $i, $d ) = offsets( $n );
    last if $i > @arr;
    my $j = @arr - $i;
    @arr[ $j+1..$#arr ] = reverse @arr[ $j+1..$#arr ];
    @arr[ $j, $j+$d ] = @arr[ $j+$d, $j ];
    redo;
  }
}

##</code><code>##

    my $j = @arr - $i;
    @arr[ $j+1..$#arr ] = reverse @arr[ $j+1..$#arr ];
    @arr[ $j, $j+$d ] = @arr[ $j+$d, $j ];

##</code><code>##

    @arr[ 0..$i-1 ] = reverse @arr[ 0..$i-1 ];

##</code><code>##

    if ( $i % 2 ) {
      @arr[ $i-1, 0 ] = @arr[ 0, $i-1 ];
    }
    else {
      @arr[ $i-1, $d-1 ] = @arr[ $d-1, $i-1 ];
    }

##</code><code>##

Iterator {...}

##</code><code>##

\sum_{k=0}^{m-1}k*k! = m!-1

##</code><code>##

(m - 1)*(m - 1)! + (m - 1)! - 1 = m! - 1

##</code><code>##

sub n_to_fb {
  my ( $n, $m ) = @_;
  my @fb;
  for my $i ( 2 .. $m ) {
    my $r = $n % $i;
    unshift @fb, $r;
    $n = int( $n/$i );
    ++$i;
  }
  return $n ? undef : \@fb;
}