#!/usr/bin/perl
use strict;
use warnings;

# Das proc verzeichnis
my $proc ="/proc";

# die Datei in der die ParentID drin steht
# /proc/<pid>/stat
# an vierter Stelle, durch Leerzeichen getrennt
my $stat ="stat";

# das Verzeichnis mit den Filedeiskeptoren
# sind SymLinks auf die Dateien (oder pipes, oder socket)
# sie sind durchnummeriert
# /proc/<id>/fd/<0...n>
# nicht selten ist 0 stdin, 1 stdout, 2 stderr
my $stdout ="fd/*";

my $device="";
my $pid=$$;
do
{
  # alle links Durcharbeiten
  for my $dev (glob("$proc/$pid/$stdout"))
  {
    $dev=readlink($dev);
    $dev="unknown" unless(defined($dev));
    # ist es eine Console?
    # tty "echte" Konsole
    # pts "virtuelle" Konsole
    # es gibt aber noch andere Consolen
    # die Ausgabe könnte z.B auf einen serielen Port erfolgen...
    if($dev=~m!^/dev/.*(?:pts|tty)!)
    {
      $device = $dev;
      $pid == 0;
      last;
    }
  }

  if($pid != 0)
  {
    # stat auslesen für den prozess,
    # brauchen die ElternProzessID (ppid)
    my @stat;
    {
      local @ARGV=("$proc/$pid/$stat");
      local $/=' ';
      @stat=<>;
      chomp(@stat);
    };
    $pid=$stat[3];
  }

} while($pid > 0);


#print "CONSOLE: $device\n";

# Eine kleine Testausgabe
# es kann sein, dass man keine Berechtigung hat Daten zu schreiben/lesen
if($device ne "")
{
  open(my $devh, ">", $device) or die "ERROR open $device ($!)";
  print $devh "Hallo Welt auf Device: $device\n";
  close($devh);
}