This commit was generated by cvs2svn to compensate for changes in r2,

which included commits to RCS files with non-trunk default branches.
2026-06-02 05:17:03 +08:00 · 2005-01-25 10:57:55 +00:00
parent 06f262c7a3
commit 9907c23028
297 changed files with 36428 additions and 0 deletions
@@ -0,0 +1,219 @@
+package Paparazzi::CpGui;
+
+use Subject;
+use Paparazzi::CpSessionMgr;
+@ISA = qw(Paparazzi::CpSessionMgr);
+
+use strict;
+
+use Tk;
+use Tk::MainWindow;
+use Tk::NoteBook;
+use Tk::HList;
+use Tk::ItemStyle;
+use Data::Dumper;
+
+sub populate {
+  my ($self, $args) = @_;
+  $self->SUPER::populate($args);
+  $self->configspec(-logo_file => [S_NOINIT,   S_PASSIVE,  S_RDWR,   S_OVRWRT, S_NOPRPG, undef],
+		    -variables => [S_SUPER,    S_SUPER,    S_SUPER,  S_SUPER,  S_SUPER, undef],
+		   );
+}
+sub completeinit {
+  my ($self) = @_;
+  $self->SUPER::completeinit();
+  $self->build_gui();
+}
+
+sub onProgramSelected {
+  my ($self, $pgm_name) = @_;
+  $self->toggle_program("NONE", $pgm_name, []);
+}
+
+sub onSessionSelected {
+  my ($self, $session_name) = @_;
+  $self->start_session($session_name);
+}
+
+use constant LIST_WIDTH => 80;
+use constant LIST_HEIGHT => 20;
+
+sub build_gui {
+  my ($self) = @_;
+  my $mw = MainWindow->new();
+  $mw->title ($self->{cp_name});
+  # menu bar
+  my $menubar =
+    $mw->Frame( -relief => 'ridge')->pack(-side => 'top', -fill => 'x');
+  my $session_menu = $menubar->Menubutton(-text => 'Sessions')->pack(-side => 'left');;
+  my $sessions = $self->get('-sessions');
+  foreach my $session_name (keys %{$sessions}) {
+    $session_menu->command( -label  => $session_name,
+			    -command => [\&onSessionSelected, $self, $session_name] );
+  }
+  my $program_menu = $menubar->Menubutton(-text => 'Programs')->pack(-side => 'left');;
+  my $programs = $self->get(-programs);
+  foreach my $pgm_name (keys %{$programs}) {
+    $program_menu->command( -label  => $pgm_name,
+			    -command => [\&onProgramSelected, $self, $pgm_name]
+			  );
+  }
+  # session frame
+  my $session_frame = $mw->Frame( -relief => 'groove')->pack(-side => 'bottom', -fill => 'both', -expand => "yes",);
+  my $notebook = $session_frame->NoteBook( -ipadx => 6, -ipady => 6);
+  $notebook->pack(-expand => "yes",
+		  -fill => "both",
+		  -padx => 5, -pady => 5,
+		  -side => "top");
+  $self->build_logo_page($notebook);
+  $self->build_list_page($notebook, "hosts", "Hosts", ["name", "ip", "status"], \&build_hosts_page);
+  $self->build_list_page($notebook, "variables", "Variables", ["name", "value"], \&build_variables_page);
+#  $self->build_list_page($notebook, "programs", "Programs", ["name", "command", "args"], \&build_programs_page);
+  $self->build_programs_page($notebook);
+  $self->build_list_page($notebook, "sessions", "Sessions", ["name", "command", "args"], \&build_sessions_page);
+#  $self->build_programs_page($notebook);
+# my $programs_page = $notebook->add("programs", -label => "Programs", -underline => 0);
+#  my $sessions_page = $notebook->add("sessions", -label => "Sessions", -underline => 0);
+
+  $self->{session_frame} = $session_frame;
+}
+
+
+sub build_logo_page {
+  my ($self, $notebook) = @_;
+  my $logo_filename = $self->get('-logo_file');
+  return unless defined $logo_filename;
+  my $logo_page = $notebook->add("logo", -label => "Logo", -underline => 0);
+  my $image = $logo_page->Photo('logogif',
+				-format => 'GIF',
+				-file => $logo_filename);
+  my $labelImage = $logo_page->Label('-image' => 'logogif')->pack();
+  return $logo_page;
+}
+
+
+sub build_hosts_page {
+  my ($self, $hlist, $e, $section_h, $item) = @_;
+  $hlist->itemCreate ($e, 0,
+		      -itemtype => 'text',
+		      -text => $item
+		     );
+  my $ip = $section_h->{$item};
+  $hlist->itemCreate ($e, 1,
+		      -itemtype => 'text',
+		      -text => $ip?$ip:"unknown"
+		     );
+ $hlist->itemCreate ($e, 2,
+		      -itemtype => 'text',
+		      -text => "unknown"
+		     );
+}
+
+sub build_variables_page {
+  my ($self, $hlist, $e, $section_h, $item) = @_;
+  $hlist->itemCreate ($e, 0, -itemtype => 'text',
+		      -text => $item
+		     );
+  $hlist->itemCreate ($e, 1, -itemtype => 'text',
+		      -text => $section_h->{$item},
+		     );
+}
+
+#sub build_programs_page {
+#  my ($self, $hlist, $e, $section_h, $item) = @_;
+#  $hlist->itemCreate ($e, 0, -itemtype => 'text',
+#		      -text => $item
+#		     );
+#  $hlist->itemCreate ($e, 1, -itemtype => 'text',
+#		      -text => $section_h->{$item}->{command},
+#		     );
+
+#  $hlist->itemCreate ($e, 2, -itemtype => 'text',
+#		      -text => $section_h->{$item}->{args},
+#		     );
+#}
+
+sub build_sessions_page {
+  my ($self, $hlist, $e, $section_h, $item) = @_;
+  $hlist->itemCreate ($e, 0, -itemtype => 'text',
+		      -text => $item
+		     );
+  $hlist->itemCreate ($e, 1, -itemtype => 'text',
+		      -text => $section_h->{$item}->{command},
+		     );
+
+  $hlist->itemCreate ($e, 2, -itemtype => 'text',
+		      -text => $section_h->{$item}->{args},
+		     );
+}
+
+
+sub build_programs_page {
+  my ($self, $notebook) = @_;
+  my $page = $notebook->add("programs", -label => "Programs", -underline => 0);
+  my @header = ("name", "command", "args");
+  my $hlist = $page->Scrolled ('HList',
+#			       -selectmode => 'extended',
+			       -header => 1,
+#			       -columns => $#header + 1,
+			       -width => LIST_WIDTH,
+			       -height => LIST_HEIGHT,
+			       -itemtype => 'imagetext',
+			       -indent => 35,
+			       -separator => '/',
+			      )->grid(-sticky => 'nsew');
+#   for my $i (0 .. $#header) {
+#    $hlist->header('create', $i, -text => $header[$i]);
+#  }
+  my $section_h = $self->get('-programs');
+  foreach my $program (keys %{$section_h}) {
+#    print Dumper($section_h->{$program})."\n";
+    $hlist->add($program,  -text => $program );
+
+    $hlist->add($program."/command",  -text => "command : ".$section_h->{$program}->{command});
+    $hlist->add($program."/args",  -text => "args :");
+    my $args = $section_h->{$program}->{args};
+    foreach my $argh (@{$args}) {
+      $hlist->add($program."/args/".$argh->{flag},  -text => $argh->{flag}."\t". $argh->{type}."\t". $argh->{value});
+    }
+  }
+  return $page
+}
+
+
+sub build_list_page {
+  my ($self, $notebook, $section, $label, $header, $row_fun) = @_;
+  my $page = $notebook->add($section, -label => $label, -underline => 0);
+  my @header = @{$header};
+  my $hlist = $page->Scrolled ('HList',
+			       -header => 1,
+			       -columns => $#header + 1,
+			       -width => LIST_WIDTH,
+			       -height => LIST_HEIGHT,
+			      )->grid(-sticky => 'nsew');
+  for my $i (0 .. $#header) {
+#    print("header $header[$i]\n");
+    $hlist->header('create', $i, -text => $header[$i]);
+  }
+  my $section_h = $self->get('-'.$section);
+  print "CpGui variables ".Dumper($section_h) if ($section eq "variables");
+  foreach my $item (keys %{$section_h}) {
+    my $e = $hlist->addchild("");
+    &$row_fun($self, $hlist, $e, $section_h, $item);
+ #   print("$hlist, $e, $section_h, $item\n");
+  }
+  return $page
+}
+
+1;
+
+
+
+
+
+
+
+
+
+
@@ -0,0 +1,79 @@
+package Paparazzi::CpPgmMgr;
+
+use Subject;
+@ISA = ("Subject");
+
+use strict;
+
+sub populate {
+  my ($self, $args) = @_;
+  $self->SUPER::populate($args);
+  $self->configspec(-children => [S_NOINIT, S_PASSIVE, S_RDWR, S_OVRWRT, S_NOPRPG, {}],
+		   );
+}
+
+sub completeinit {
+  my $self = shift;
+  $self->SUPER::completeinit;
+}
+
+sub start_program() {
+  my ($self, $pgm, @options, @args, $keep_stdin) = @_;
+  my %children = %{$self->get('-children')};
+  
+#  print("in ChildrenSpawner::start_programm args [$pgm @args]\n");
+  my $pid = undef;
+  my $sleep_count = 0;
+  my $fh;
+  do {
+    $pid = fork();
+    $SIG{PIPE} = sub { die "whoops, $pgm pipe broke" };
+    unless (defined $pid) {
+      warn "cannot fork: $!";
+      die "bailing out" if $sleep_count++ > 6;
+      sleep 1;
+    }
+  } until defined $pid;
+
+  if (! $pid) {                # child
+    $SIG{TERM} = 'IGNORE';
+    exec ($pgm, @options, @args);# or die "couldnt exec foo: $pgm @args";
+    # NOTREACHED
+    exit(1);
+  }
+                               # parent
+  $children{$pid} = {cmd => $pgm, args => \@args};#, ktw => $fh};
+  $self->configure('-children', \%children);
+  foreach my $key (keys %children) {
+#    print("in ChildrenSpawner::start_programm child: [$key $children{$key}]\n");
+  }
+  return $pid;
+}
+
+sub stop_program() {
+  my ($self, $pid) = @_;
+#  print "in_stop_program $pid\n";
+
+  my %children = %{$self->get('-children')};
+  my $pgm = $children{$pid};
+ 
+  if (defined $pgm) {
+#    printf STDOUT "Killing Process %d [%s %s]\n", $pid, $pgm->{cmd}, $pgm->{args};
+    kill 9, $pid;
+    $children{$pid} = undef;
+    $self->configure('-children', \%children);
+  }
+}
+
+
+sub terminate_all() {
+  my ($self) = @_;
+#  print("in ChildrenSpawner::terminate_all\n");
+  my %pgms = %{$self->get('-children')};
+  foreach my $pid (keys %pgms) {
+#    print "killing $pid  ($pgms{$pid})\n";
+    $self->stop_program($pid);
+  }
+}
+
+1;
@@ -0,0 +1,192 @@
+package Paparazzi::CpSessionMgr;
+
+use Data::Dumper;
+use XML::DOM;
+use Subject;
+
+use Paparazzi::CpPgmMgr;
+@ISA = qw(Paparazzi::CpPgmMgr);
+
+use strict;
+
+sub populate {
+  my ($self, $args) = @_;
+  $self->SUPER::populate($args);
+  $self->configspec(-config_file =>  [S_NEEDINIT, S_PASSIVE,  S_RDONLY, S_OVRWRT, S_NOPRPG, undef],
+                    -bin_base_dir => [S_NOINIT,   S_PASSIVE,  S_RDWR,   S_OVRWRT, S_NOPRPG, "/usr/bin"],
+		    -log_dir =>      [S_NOINIT,   S_PASSIVE,  S_RDWR,   S_OVRWRT, S_NOPRPG, "/var/tmp"],
+		    -variables =>    [S_NOINIT,   S_PASSIVE,  S_RDWR,   S_OVRWRT, S_NOPRPG, {}],
+		    -hosts =>        [S_NOINIT,   S_PASSIVE,  S_RDWR,   S_OVRWRT, S_NOPRPG, {}],
+		    -programs =>     [S_NOINIT,   S_PASSIVE,  S_RDWR,   S_OVRWRT, S_NOPRPG, {}],
+		    -sessions =>     [S_NOINIT,   S_PASSIVE,  S_RDWR,   S_OVRWRT, S_NOPRPG, {}],
+		   );
+}
+
+sub completeinit {
+  my ($self) = @_;
+  $self->SUPER::completeinit();
+  my $cfg_file = $self->get('-config_file');
+#  my $variables = $self->get('-variables');
+#  print "initial variables\n".Dumper($variables);
+  $self->read_cfg($cfg_file);
+#  $variables = $self->get('-variables');
+#  print "configured variables\n".Dumper($variables);
+}
+
+sub prepare_args {
+  my ($self, $args) = @_;
+  my (@options, @rargs);
+  my $variables = $self->get('-variables');
+  print "CpSessionMgr : variables ".Dumper($variables);
+  foreach my $opt (@{$args}) {
+    my $type = $opt->{type};
+    my $flag = $opt->{flag};
+    my $value = $type eq 'var' ? $variables->{$opt->{value}}: $opt->{value};
+    if ($flag) {
+      if ($flag =~ /\.*=/) { push @options, $flag.$value}
+      else {push @options, $flag, $value}
+    }
+    else { push @rargs, $value}
+  }
+  return (@options, @rargs);
+}
+
+sub toggle_program {
+  my ($self, $session_name, $pgm_name, $pgm_session_args, $session_idx) = @_;
+#  shift @_;
+#  print Dumper(@_);
+  my $programs = $self->get('-programs');
+#  print "Progams ".Dumper($programs);
+  my $program = $programs->{$pgm_name};
+#  print "Toggling Progam ".Dumper($program);
+  my $command;
+  if ($program->{command} =~ /^\/.*/) {
+    $command = $program->{command};
+  }
+  else {
+    $command = $self->get('-bin_base_dir')."/".$program->{command};
+  }
+  if ($session_name eq "NONE") {
+    if (defined $program->{pid}) {
+      $self->SUPER::stop_program($program->{pid});
+      $program->{pid} = undef;
+    }
+    else {
+      my (@options, @args) = $self->prepare_args($program->{args});
+#      print Dumper($program->{args});
+      print "starting $pgm_name [$command @options, @args]\n";
+      $program->{pid} = $self->SUPER::start_program($command, @options[0..$#options], @args[0..$#args]);
+    }
+  }
+  else {
+    my @pgm_args = $self->prepare_args($program->{args});
+#    print "program->{args} ".Dumper($program->{args});
+#    print "pgm_args ".Dumper(@pgm_args);
+#    print "session ".Dumper($self->{sessions}->{$session_name});
+    
+    my $session_pgms = $self->get('-sessions')->{$session_name}->{pgms};
+#    print "session_pgms ".Dumper($session_pgms);
+    my $_session_args = ($session_pgms->[$session_idx])->{args};
+    my @session_args = defined $_session_args ? $self->prepare_args($_session_args) : [];
+#    print "session_args ".Dumper($_session_args);
+
+    push @pgm_args , @session_args;
+    print "session $session_name starting program $pgm_name\n[$command @pgm_args]\n";
+    $self->{sessions}->{$session_name}->{pgms}[$session_idx]->{pid} = $self->SUPER::start_program($command, @pgm_args[0..$#pgm_args]);   
+  }
+}
+
+sub start_session {
+  my ($self, $session_name) = @_;
+#  print "starting session $session_name\n";
+  my $sessions = $self->get('-sessions');
+  my $session = $sessions->{$session_name};
+  my @progs = @{$session->{pgms}};
+#  print "progs ".Dumper(@progs);
+  my  $session_idx = 0;
+  foreach my $pgm (@progs) {
+    my $pgm_name = $pgm->{name};
+    my $pgm_session_args = $pgm->{args};
+    $self->toggle_program($session_name, $pgm_name, $pgm_session_args, $session_idx) if (!defined $self->{programs}->{$pgm_name}->{pid});
+    $session_idx++;
+  }
+}
+
+sub xml_parse_args {
+  my ($args) = @_;
+  my @args_a;
+  foreach my $arg (@{$args}){
+    my $var = $arg->getAttribute('variable');
+    my $args_h = {
+		  flag => $arg->getAttribute('flag'),
+		  type => $var eq '' ? 'const' : 'var',
+		  value => $var eq '' ? $arg->getAttribute('constant'): $var,
+		 };
+    push @args_a, $args_h;
+  }
+#  print "@args_a\n";
+  return \@args_a;
+}
+
+sub xml_parse_section {
+  my ($self, $section) = @_;
+  my $section_name = $section->getAttribute('name');
+  my ($items_name) = ($section_name =~ /(.*)s$/);
+#  print "section $section_name items_name $items_name\n";
+  my $items = $section->getElementsByTagName($items_name);
+  my $h_name = '-'.$section_name;
+  print "h_name $h_name\n";
+  my $tmp = $self->get($h_name);
+  foreach my $item (@{$items}){
+    if ($section_name eq "hosts") {
+      $tmp->{$item->getAttribute('name')} = $item->getAttribute('ip');
+    }
+    elsif ($section_name eq 'variables') {
+      $tmp->{$item->getAttribute('name')} = $item->getAttribute('value');
+    } 
+    elsif ($section_name eq 'programs') {
+      my $pgm_name = $item->getAttribute('name');
+      my $args = $item->getElementsByTagName("arg");
+      my $args_h = xml_parse_args($args);
+      $tmp->{$pgm_name} =
+	{name => $pgm_name,
+	 command => $item->getAttribute('command'),
+	 args => $args_h,
+	};
+    }
+    elsif ($section_name eq 'sessions') {
+      my $session_name = $item->getAttribute('name');
+      my $xsessions_pgms = $item->getElementsByTagName("program");
+      my @sessions_pgms;
+      foreach my $session_pgm (@{$xsessions_pgms}){
+	my $pgm_name = $session_pgm->getAttribute('name');
+	my $session_args = $session_pgm->getElementsByTagName("arg");
+	my $args_h = xml_parse_args($session_args);
+	push @sessions_pgms, {
+			      name => $pgm_name,
+			      args => $args_h
+			     };
+      }
+      $tmp->{$session_name} = {
+			       name => $session_name,
+			       pgms => \@sessions_pgms
+			      };
+    }
+  }
+  $self->configure($h_name => $tmp);
+}
+
+sub read_cfg {
+  my ($self, $filename) = @_;
+  my $parser = XML::DOM::Parser->new();
+  my $doc = $parser->parsefile($filename);
+  my $cp = $doc->getElementsByTagName("control_panel")->[0];
+  $self->{cp_name} = $cp->getAttribute('name');
+  my $sections = $cp->getElementsByTagName("section");
+  foreach my $section (@{$sections}) {
+    $self->xml_parse_section($section);
+  }
+}
+
+
+1;
@@ -0,0 +1,80 @@
+#!/usr/bin/perl -w
+package Paparazzi;
+
+my $paparazzi_lib;
+BEGIN {
+  $paparazzi_lib = (defined $ENV{PAPARAZZI_SRC}) ?
+    $ENV{PAPARAZZI_SRC}."/sw/lib/perl" : "/usr/lib/paparazzi/";
+}
+use lib ($paparazzi_lib);
+
+use Paparazzi::CpGui;
+@ISA = qw(Paparazzi::CpGui);
+
+use Paparazzi::Environment;
+
+use strict;
+
+use Tk;
+use Subject;
+
+use Data::Dumper;
+use Getopt::Long;
+
+sub populate {
+  my ($self, $args) = @_;
+  my $paparazzi_src = Paparazzi::Environment::paparazzi_src();
+  my $paparazzi_home = Paparazzi::Environment::paparazzi_home();
+  Paparazzi::Environment::check_paparazzi_home();
+  $args->{-config_file} = $paparazzi_home."/conf/control_panel.xml";
+  $args->{-variables} = {paparazzi_home => $paparazzi_home};
+  $args->{-bin_base_dir} = $paparazzi_src;
+  $args->{-logo_file} = $paparazzi_home."/data/pictures/penguin_logo.gif";
+  $self->SUPER::populate($args);
+  $self->configspec(-variables => [S_SUPER,    S_SUPER,    S_SUPER,  S_SUPER,  S_SUPER, undef]);
+}
+sub completeinit {
+  my ($self) = @_;
+  $self->SUPER::completeinit();
+  $self->parse_args();
+}
+
+sub parse_args {
+  my ($self) = @_;
+  my $options = {
+		 ivy_bus => "127.255.255.255:2005",
+		 map => "maps/muret_UTM.xml",
+		 render => "1",
+		};
+  GetOptions("b=s" => \$options->{ivy_bus},
+	     "m=s" => \$options->{map},
+	     "r=s" => \$options->{render},
+	    );
+  my $variables = $self->get('-variables');
+  foreach my $var (keys %{$options}) {
+    $variables->{$var} = $options->{$var};
+  }
+  $self->configure('-variables' => $variables);
+}
+
+sub catchSigTerm() {
+  my ($paparazzi) = @_;
+  printf("in catchSigTerm\n");
+  $paparazzi->terminate_all();
+}
+
+my $paparazzi = Paparazzi->new();
+$SIG{TERM} = sub {$paparazzi->catchSigTerm()};
+Tk::MainLoop();
+$paparazzi->catchSigTerm();
+
+1;
+
+
+
+
+
+
+
+
+