debug.pl 1.2 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. # Local modules
  5. use Cwd qw(abs_path);
  6. use File::Basename qw(dirname);
  7. use lib dirname(abs_path($0));
  8. use DMX;
  9. # User config
  10. my %DIM = ();
  11. my $DELAY = 10;
  12. # App config
  13. my $STATE_SOCK = 'DEBUG';
  14. # Allow one-shot mode or force debug
  15. my $KEY = undef();
  16. if (scalar(@ARGV) > 0) {
  17. $KEY = $ARGV[0];
  18. } else {
  19. DMX::debug(1);
  20. }
  21. # Sockets
  22. DMX::stateSocket($STATE_SOCK);
  23. DMX::stateSubscribe($STATE_SOCK);
  24. # Loop forever
  25. my %exists = ();
  26. my %mtime = ();
  27. while (1) {
  28. my $state = DMX::readState($DELAY, \%exists, \%mtime, undef());
  29. if ($state) {
  30. # One-shot mode
  31. if (defined($KEY)) {
  32. if (exists($exists{$KEY})) {
  33. print $exists{$KEY} . '@' . $mtime{$KEY} . "\n";
  34. } else {
  35. print STDERR 'No such element: ' . $KEY . "\n";
  36. }
  37. exit 0;
  38. }
  39. # Find the latest modification timestamp
  40. my $file = undef();
  41. foreach my $key (keys(%mtime)) {
  42. if (!defined($file) || $mtime{$key} > $mtime{$file}) {
  43. $file = $key;
  44. }
  45. }
  46. # Pretty print
  47. my $time = 0;
  48. if (defined($file)) {
  49. $time = $mtime{$file};
  50. } else {
  51. $file = '<NO MTIME DATA>';
  52. }
  53. print STDERR "\tLast update: " . $file . ': ' . localtime($time) . "\n";
  54. }
  55. }