#!/usr/bin/perl
use strict;

my @elemente=@ARGV;
die "$0 element_a element_b [[[element_d] element_c] ...]\n" if(@elemente<=1);

print "Elemente: ".join('; ', @elemente)."\n";
my @liste=();

print "Variantionen A:\n";
@liste=&variants_a(@elemente);
for my $ele (@liste)
{ print "  ".join('; ',@{$ele})."\n"; }

print "Variantionen B:\n";
@liste=&variants_b(@elemente);
for my $ele (@liste)
{ print "  ".join('; ',@{$ele})."\n"; }

# Rekursiv Programmiert
# Die Funktion ruft sich selber auf,
# solange im Array noch Elemnte enthalten sind.
# Zurückgeben wird immer ein Array mit anonymen Arrays darin.
#
# zu bemerken ist, daß die vollständige Liste
# aller Variationen erst zur verfügung steht,
# wenn die funktion vollstzändig durchgelaufen ist.
# Dafür aber ist sie sehr schnell, verbraucht aber auch recht viel Speicher
sub variants_a(@)
{
 my (@arr) = @_;
 # erstes Element entfernen
 my $first=shift(@arr);
 # wenn kein Element mehr in der Liste ist,
 # dann gib ein Array mit zwei anonymen Arrays zurück,
 # welche jeweils ein Element, groß und kleingeschrieben enhalten
 return ([lc($first)],[uc($first)]) unless(@arr>0);
 # sind noch Elemnte enthalten, so rufe die Funktion nochmal auf
 # und übergebe das restliche Array
 # gehe die gesammte Rückkabe durch und ersetze jedes anonyme Array durch zwei neue,
 # vor die jeweils das alte anonyme Array enthalten,
 # plus der Groß/Kleinschreibvariante es entfernten Elementes
 return map { ( [lc($first),@{$_}], [uc($first),@{$_}] ) } variants_a(@arr);
}

# Als binärer Zähler Programmiert
# jedes Element wird als "Bit" aufgefasst,
# welches Zwei zusände annehmen kann.
# Entweder wird es groß geschrieben (1),
# oder klein geschrieben (0).
# dann wird Hochgezählt.
# Ein Beispiel an 3 Elemneten
# 0;0;0
# 1;0;0
# 0;1;0
# 1;1;0
# 0;0;1
# 1;0;1
# 0;1;1
# 1;1;1
#
# Hier steht zu jedem Zeitpunkt
# eine vollständige Liste aller Elemnte
# und deren aktuelle Zustände zur verfügung.
# Die Funktion ist Speichersparend,
# aber auch recht langsam
sub variants_b(@)
{
 my (@arr) = @_;
 my @ret=();
 # erstmal alles kleinschreiben
 # (alle Bits auf 0)
 for my $i (@arr){ $i=lc($i); }
 my $lang=@arr;
 my $i=1;
 # solange nicht das gesammte Array durchlaufen wurde
 # weiter machen
 while($i<$lang)
 {
  # Jedes Element im array anstringen
  for($i=0; $i<$lang; $i++)
  {
   # ist ein Element klein geschrieben? (0)
   if(lc($arr[$i]) eq $arr[$i])
   {
    # Element groß schreiben (1)
    $arr[$i]=uc($arr[$i]);
    # for-schleife abbrechen
    last;
   }
   # Element klein schreiben (0)
   $arr[$i]=lc($arr[$i]);
  }
  # Aktuellen Zustand des Array kopieren und als anonymes Array speichern
  push(@ret,[@arr]);
 }
 return @ret;
}

sub modify {
   my ($str) = @_;

   my ($head, $tail) = ( substr($str, 0, 1), substr($str, 1, length($str)-1) );

   return length($tail) ? map { (lc($head) . $_, uc($head) . $_) } modify($tail) : $head;
}

printf("$_\n") foreach ( modify('abcdef') );

sub variants {
  my $e=shift(@_);
  return @_ ? map { ( [lc($e),@{$_}], [uc($e),@{$_}] ) } variants(@_) : ([lc($e)],[uc($e)]);
}