fixed alphabetical sorting in dropdown menus, began work on plotting system

diff --git a/tools/HPlot.pm b/tools/HPlot.pm
new file mode 120000 (symlink)
index 0000000..7a86abf
--- /dev/null
+++ b/tools/HPlot.pm
@@ -0,0 +1 @@
+../../daqtools/web/htdocs/commands/HPlot.pm
\ No newline at end of file

diff --git a/tools/PlotScheduler.pm b/tools/PlotScheduler.pm
new file mode 100644 (file)
index 0000000..09dacd5
--- /dev/null
+++ b/tools/PlotScheduler.pm
@@ -0,0 +1,122 @@
+package PlotScheduler;
+
+
+use strict;
+use warnings;
+use POSIX;
+
+use Storable qw(lock_store lock_retrieve);
+use Data::Dumper;
+
+use Time::HiRes;
+
+require Common;
+
+
+use FindBin;
+use lib "$FindBin::Bin/..";
+
+sub new {
+  my $class = shift;
+  my %options = @_;
+  my $self  = {
+    shm => '/dev/null',
+    timeout => 10,
+    requests => {},
+    maxRepeats => 5,
+    %options
+  };
+  bless($self, $class);
+}
+
+
+sub addRequest {
+  my $self = shift;
+  my %param = @_;
+  my $FPGA = $param{FPGA};
+  my $CB = $param{CB};
+  my $chip = $param{chip};
+  my $channel = $param{channel};
+  $self->{requests}->{"$FPGA-$CB-$chip-$channel"} = time();
+}
+
+sub enforceTimeout {
+  my $self = shift;
+  my $now = time();
+  for my $request (keys $self->{requests}) {
+    my $timestamp = $self->{requests}->{$request};
+    if ( ($now - $timestamp) > $self->{timeout} ) {
+      delete $self->{requests}->{$request};
+    }
+  }
+}
+
+sub retrieveRequests {
+  my $self = shift;
+  if ( -e $self->{shm} ){
+    # load shared memory
+    for( my $i = 0 ; $i < $self->{maxRepeats}; $i++){
+      $self->{requests} = lock_retrieve($self->{shm});
+      if( defined ($self->{requests})) {
+       last;
+      } else {
+       Time::HiRes::sleep(rand()/10*$i/$self->{maxRepeats}); # if you don't get it step back
+      }
+    }
+  }
+}
+
+sub storeRequests {
+  my $self = shift;
+  if ( -e $self->{shm} ){
+    for( my $i = 0 ; $i < $self->{maxRepeats}; $i++){
+      if( lock_store($self->{requests},$self->{shm}) ) {
+       last;
+      } else {
+       Time::HiRes::sleep(rand()/10*$i/$self->{maxRepeats}); # if you don't get it step back
+      }
+    }
+  }
+}
+
+sub requestCount {
+  my $self=shift;
+  return scalar(keys %{$self->{requests}});
+}
+
+sub submitRequests {
+  # loads old requests,
+  # overwrites identical requests with new ones
+  # writes all requests back to shm
+  my $self = shift;
+  my $oldStoreRef = {};
+  if ( -e $self->{shm} ){
+    # load shared memory
+    $oldStoreRef = lock_retrieve($self->{shm});
+  }
+  
+  my $newStoreRef = { %$oldStoreRef,%{$self->{requests}} };
+  lock_store($newStoreRef,$self->{shm});
+}
+
+sub listRequests {
+  my $self = shift;
+  print Dumper $self->{requests};
+}
+
+sub deleteShm {
+  my $self = shift;
+  unlink $self->{shm};
+}
+
+sub plotServiceRunning {
+  my $self = shift;
+  return (-e $self->{shm});
+}
+
+sub createShm {
+  my $self = shift;
+  lock_store({},$self->{shm});
+};
+
+1;
\ No newline at end of file

diff --git a/tools/Widgets.pm b/tools/Widgets.pm
index 9efe195bcf629b7967baa6b1fb5cfacfb60ed6ef..8821b73675dd1cff4766ac2fe6a25548dfa3e0a5 100644 (file)
--- a/tools/Widgets.pm
+++ b/tools/Widgets.pm
@@ -81,7 +81,7 @@ sub print_html {
 
 #   print "<option value='...'>...</option>";
   
-  for my $item ( sort @{$self->{items}} ) {
+  for my $item ( sort { lc($a->{value}) cmp lc($b->{value})} @{$self->{items}} ) {
     print q%<option value='%.$item->{value}.q%' %;
     if(defined($item->{selected}) or ($self->{selected} eq $item->{value})){
       print q%selected%;

diff --git a/tools/adcmon.pl b/tools/adcmon.pl
new file mode 100755 (executable)
index 0000000..609c636
--- /dev/null
+++ b/tools/adcmon.pl
@@ -0,0 +1,39 @@
+#!/usr/bin/perl -w
+
+
+my $me = "adcmon.pl";
+
+use strict;
+use warnings;
+# use XML::LibXML;
+use POSIX;
+# use CGI ':standard';
+# use CGI::Carp qw(fatalsToBrowser);
+# use HTML::Entities;
+# use Widgets;
+
+use PlotScheduler;
+
+# use HPlot;
+
+# require Common;
+# require xmlOperations;
+# require xmlRendering;
+
+
+use FindBin;
+use lib "$FindBin::Bin/..";
+use Environment;
+
+
+
+my $ps = PlotScheduler->new( shm => "/dev/shm/DQ55_88" );
+# $ps->addRequest( FPGA => "0xd882", CB => "0", chip => "1", channel => "TEMP");
+$ps->storeRequests();
+while(1){
+$ps->retrieveRequests();
+$ps->addRequest( FPGA => "0xd882", CB => "0", chip => "1", channel => "VDDA");
+$ps->listRequests();
+$ps->storeRequests();
+sleep 1;
+}

diff --git a/tools/plotService.pl b/tools/plotService.pl
new file mode 100755 (executable)
index 0000000..59594a1
--- /dev/null
+++ b/tools/plotService.pl
@@ -0,0 +1,66 @@
+#!/usr/bin/perl -w
+
+
+my $me = "plotService.pl";
+
+my $verbose = 1;
+my $suicideTimeout = 5;
+
+use strict;
+use warnings;
+use POSIX;
+# use CGI ':standard';
+# use CGI::Carp qw(fatalsToBrowser);
+use Storable qw(lock_store lock_retrieve);
+use Data::Dumper;
+use HADES::TrbNet;
+use HPlot;
+use Getopt::Long;
+
+require Common;
+
+use PlotScheduler;
+
+use FindBin;
+use lib "$FindBin::Bin/..";
+
+my $shm = "/dev/null";
+my $timeout = 10;
+my $suicideTimer = time();
+
+Getopt::Long::Configure(qw(gnu_getopt));
+GetOptions(
+           'shm=s' => \$shm,
+           'timeout=s' => \$timeout,
+          );
+
+
+my $ps = PlotScheduler->new( shm => $shm, timeout => $timeout);
+$ps->createShm(); # create empty shm
+
+while(1) {
+
+  $ps->retrieveRequests();
+  $ps->enforceTimeout();
+  $ps->storeRequests();
+  $ps->listRequests() if $verbose;
+  
+  print "number of requests:".$ps->requestCount()."\n" if $verbose;
+  checkForSuicide($ps->requestCount());
+  sleep 1;
+
+
+}
+
+sub checkForSuicide {
+  my $argument = shift;
+  if($argument) {
+    $suicideTimer = time();
+  } else {
+    if( time() - $suicideTimer > $suicideTimeout){
+      print "idle timeout\n" if $verbose;
+      $ps->deleteShm();
+      exit;
+    }
+  }
+}
\ No newline at end of file