
my @chars = split //, 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789,./<>?;\':"\\[]{}`~|!@#$%^&*()-=_+';
push @chars, "\n", "\t", " ";
my %graph;
my $EDGES;

for my $a (@chars) {
  for my $b (@chars) {
    $graph{$a}{$b} = 1;  # There is an edge from A to B
    $EDGES++;
  }
}
my $result;
# Initialize $result to contain the circuit "aabacadae...yaza"
{ my $c1 = $chars[0];
  $result = $c1;
  delete $graph{$c1}{$c1};
  $EDGES--;
  for (@chars) {
    next if $_ eq $c1;
    $result .= "$c1$_";
    delete $graph{$c1}{$_};
    delete $graph{$_}{$c1};
    $EDGES-=2;
  }
  if ($graph{$c1} && ! %{$graph{$c1}}) {
    delete $graph{$c1};
  } else {
    die;  # Can never happen
  }
  # Boundary condition
  $result .= $c1;
}

while ($EDGES) {
  print STDERR "$EDGES pairs to go...    \r";
  # Find a letter with an unused out-edge
  my ($cur) = keys %graph;

  # Wander around until the path returns to $cur
  my $chain = make_circuit_from($cur);

  # Insert the new circuit into the result
  my $target = index($result, $cur);
  die if $target == -1; # Can't happen
  substr($result, $target, 1) = $chain;
}
print STDERR "\n";

print $result;

sub make_circuit_from {
  my $chain = my $cur = my $start = shift;
  do {
    my ($next) = keys %{$graph{$cur}};
    $chain .= $next;
    delete $graph{$cur}{$next};
    $EDGES--;
    delete $graph{$cur} unless %{$graph{$cur}};
    $cur = $next;
  } until $cur eq $start;
  $chain;
}
