as pulled from private repository

SLS

+#!/usr/bin/perl
+#
+# find or create screen session
+#
+# $Id: SLS,v 1.3 2012/12/14 13:35:38 gonter Exp $
+#
+
+=pod
+
+=head1 USAGE
+
+  SLS [-opts] [session]
+
+=head1 DESCRIPTION
+
+reattach or create screen which matches given session name
+
+=head1 SYNOPSIS
+
+  SLS mistkisten
+
+... reattaches or creates a screen called "mistkisten"
+
+  SLS mistk
+
+... reattaches the screen called "mistkisten" which was created earlier (or otherwise it creates a screen called "mistk")
+
+=head1 Options
+
+ -P ... supress process listin
+ -n ... do not actually perform screen command
+ -c ... create new session even if one matches
+ -t ... print entire process tree for a given screen session
+
+=cut
+
+use strict;
+
+use Data::Dumper;
+$Data::Dumper::Indent= 1;
+
+my $print_tree= 0;  # 0 print only last command; 1 print all commands in the tree
+my $create= 0;
+my $doit= 1;
+my $list_processes= 1;
+my $debug= 0;
+
+my @PARS= ();
+PARS: while (defined (my $arg= shift (@ARGV)))
+{
+  if ($arg =~ /^-/)
+  {
+    if ($arg eq '--') { push (@PARS, @ARGV); last PARS; }
+    elsif ($arg eq '-c') { $create= 1; }
+    elsif ($arg eq '-n') { $doit= 0; }
+    elsif ($arg eq '-P') { $list_processes= 0; }
+    elsif ($arg eq '-t') { $print_tree= 1; }
+    elsif ($arg =~ /^-(D+)/) { $debug += length ($1); }
+    else { &usage (); exit (0); }
+  }
+  else
+  {
+    push (@PARS, $arg);
+  }
+}
+
+my $S= &screen_ls ();
+## print Dumper ($S);
+
+my $hostname= &get_hostname ();
+
+if (@PARS)
+{
+  my $wanted= shift (@PARS);
+
+  my $dir_changed= 0;
+
+  my @screens= &find_screens_by_label ($S, $wanted);
+  my $cnt= @screens;
+  print "create=$create cnt=$cnt screens=", join ('|', @screens), "\n";
+
+  if ($create || $cnt == 0)
+  { # no matching screen or force creation
+
+    if (@PARS)
+    {
+      my $cdir= shift (@PARS);
+      &chdir ($cdir);
+      $dir_changed= 1;
+    }
+
+    my $cmd_title= "settitle '$hostname:$wanted'";
+    print ">>> $cmd_title\n";
+    system ($cmd_title) if ($doit);
+
+    my $cmd_screen= "screen -S '$wanted'";
+    print ">>> $cmd_screen\n";
+    if ($doit)
+    {
+      if (!$dir_changed && $wanted =~ /notes/i) { &chdir ("common/Notes"); $dir_changed= 1; }
+      system ($cmd_screen);
+    }
+  }
+  elsif ($cnt == 1)
+  {
+    $wanted= shift (@screens);
+
+    my $cmd_title= "settitle '$hostname:$wanted'";
+    print ">>> $cmd_title\n";
+    system ($cmd_title) if ($doit);
+
+    my $cmd_screen= "screen -dR '$wanted'";
+    print ">>> $cmd_screen\n";
+    system ($cmd_screen) if ($doit);
+  }
+  else # $cnt > 0: more than one screen found, so give user a chance to be more specific
+  {
+    my $PS;
+
+    if ($list_processes)
+    {
+      $PS= &ps ('alfxww');
+      ## print Dumper ($PS);
+    }
+
+    &print_screens_by_label2 ($S, $PS, @screens);
+  }
+}
+else
+{
+  my $PS;
+  if ($list_processes)
+  {
+    $PS= &ps ('alfx');
+    ## print Dumper ($PS);
+  }
+
+  &print_screens_by_label ($S, $PS);
+}
+
+exit (0);
+
+sub chdir
+{
+  my $dir= shift;
+  print ">>> chdir '$dir'\n";
+  # sleep (5);
+
+  unless (chdir && chdir $dir)
+  {
+    print ">>> ATTN: cant change to '$dir' (", $@, ")\n";
+    sleep (5);
+  }
+}
+
+sub usage
+{
+  exec ("perldoc '$0'");
+}
+
+sub get_hostname
+{
+  my $x= $ENV{'BLA'};
+
+  unless ($x)
+  {
+    my ($OS, $y)= split (' ', `uname -a`);
+    $x= $y;
+  }
+
+  if ($x)
+  {
+    my @x= split (/\./, $x);
+    my $x= shift (@x);
+
+    # check if $x may need more info
+    return $x;
+  }
+  
+}
+
+sub find_screens_by_label
+{
+  my $S= shift;
+  my $wanted= shift;
+
+  print ">> matching /$wanted/i\n";
+  my @res= ();
+
+  my $Sl= $S->{'labels'};
+  foreach my $l (sort keys %$Sl)
+  {
+    print "l=[$l]\n";
+    if ($l =~ /$wanted/i)
+    {
+      push (@res, $l)
+    }
+  }
+
+  @res;
+}
+
+sub print_screens_by_pid
+{
+  my $S= shift;
+  my $PS= shift;
+
+  my $Ss= $S->{'screens'};
+  foreach my $p (sort {$a <=> $b} keys %$Ss)
+  {
+    my $x= $Ss->{$p};
+    my ($pid, $status, $label)= map { $x->{$_} } qw(pid status label);
+    printf ("%7d %s %s\n", $pid, $status, $label);
+    &print_cmd ($PS, $pid, 0);
+  }
+}
+
+sub print_screens_by_label
+{
+  my $S= shift;
+  my $PS= shift;
+
+  &print_screens_by_label2 ($S, $PS, sort keys %{$S->{'labels'}});
+}
+
+sub print_screens_by_label2
+{
+  my $S= shift;
+  my $PS= shift;
+  my @labels= @_;
+
+  printf ("%7s %8s %s\n", 'PID', 'Status', 'Label');
+
+  my $Sl= $S->{'labels'};
+  foreach my $l (@labels)
+  {
+    my $x= $Sl->{$l};
+    my ($pid, $status, $label)= map { $x->{$_} } qw(pid status label);
+    printf ("%7d %s %s\n", $pid, $status, $label);
+    &print_cmd ($PS, $pid, 0);
+  }
+}
+
+sub print_cmd
+{
+  my $PS= shift;
+  my $pid= shift;
+  my $indent= shift;
+
+  return unless ($PS);
+
+  ## print join (' ', __LINE__, 'pid', $pid, $indent), "\n";
+
+  my $p= $PS->{'pids'}->{$pid};
+  my $c= $PS->{'c'}->{$pid};
+
+  if (defined ($p)   # note: a process with the screen's pid is not in ps list
+      && ($print_tree || !defined ($c))
+     )
+  {
+    $indent += 2;
+
+    my $label_idx= $PS->{'label_idx'};
+    my ($pid, $cmd)= map { $p->[$label_idx->{$_}] } qw(PID COMMAND);
+    printf ("%7d         %s %s\n", $pid, ' 'x$indent, $cmd);
+    ## print ' 'x$indent, join (' ', @$p), "\n";
+  }
+
+  if (defined ($c))
+  {
+    ## print ' 'x$indent, join (' ', '->', @$c), "\n";
+    foreach my $cpid (@$c)
+    {
+      &print_cmd ($PS, $cpid, $indent);
+    }
+  }
+}
+
+sub screen_ls
+{
+  local *S;
+  open (S, "screen -ls|") or return undef;
+
+  my %screens= ();
+  my %labels= ();
+  my $screens=
+  {
+    'screens' => \%screens,
+    'labels' => \%labels,
+  };
+
+  while (<S>)
+  {
+    chop;
+    print ">>>> $_\n" if ($debug >= 2);
+
+    if (/^There are screens on:/
+	|| /^\s*$/
+       )
+    { # NOP;
+    }
+    elsif (/^(\d+) Sockets in (.+)/)
+    {
+      ($screens->{'cnt'}, $screens->{'socket_dir'})= ($1, $2);
+    }
+    elsif (/\s+(\d+)\.(.+)\s*\((Attached|Detached)\)/)
+    {
+      my ($pid, $label, $status)= ($1, $2, $3);
+      my $extra;
+      if ($label =~ /(.+)\s+\((.+)\)/)
+      {
+        ($label, $extra)= ($1, $2);
+      }
+      else
+      {
+        $label=~ s/\s*$//;
+      }
+      ## print ">>>>> pid='$pid' label='$label' status='$status'\n";
+
+      my $screen=
+      {
+	'pid' => $pid,
+	'label' => $label,
+	'status' => $status,
+      };
+      $screen->{'extra'}= $extra if ($extra);
+
+      $screens{$pid}= $screen;
+      $labels{$label}= $screen;
+    }
+  }
+  close (S);
+
+print Dumper ($screens) if ($debug >= 3);
+  $screens;
+}
+
+sub ps
+{
+  my $options= shift || 'alf';
+
+  local *PS;
+  open (PS, "ps '$options'|") or die "cant call ps with options='$options'";
+
+  my %pids= ();
+  my @labels= ();
+  my %label_idx= ();
+  my %c= ();
+  my $ps=
+  {
+    'labels' => \@labels,
+    'label_idx' => \%label_idx,
+    'pids' => \%pids,
+    'c' => \%c,
+  };
+  my $columns= 999;
+
+  while (<PS>)
+  {
+    chop;
+    ## print ">>> $_\n";
+    my @f= split (' ', $_, $columns);
+
+    unless (@labels)
+    { # first line is the label of the output
+      @labels= @f;
+      for (my $i= 0; $i <= $#labels; $i++)
+      {
+	$label_idx{$labels[$i]}= $i;
+	$columns= $i+1;
+      }
+      $ps->{'columns'}= $columns;
+    }
+    else
+    { 
+      my ($pid, $ppid)= map { @f[$label_idx{$_}] } qw(PID PPID);
+
+      ## print ">>>>> pid='$pid' ppid='$ppid'\n";
+      $pids{$pid}= \@f;
+      push (@{$c{$ppid}}, $pid);
+    }
+  }
+  close (PS);
+
+  $ps;
+}
+
+__END__
+
+=pod
+
+[2008-06-25 19:30]
+
+=head1 TODO
+
+=head2 Config File
+
+rk_dir= DIR => CD vor screen -S ausfuehren
+(what the hell, what does rk_dir mean? chdir?)
+