added alternate presentation hierarchies. Configure via Presentation->hierarchies and

Targets ... -> parents -- tobi

5 files changed, 131 insertions, 70 deletions

diff --git a/CHANGES b/CHANGES
index d4d37a7..b449c88 100644
--- a/CHANGES
+++ b/CHANGES
@@ -1,3 +1,7 @@
+
+* Added support for alternate presentation hierarchies
+  check Presentation->hierarchies and Target->parents --tobi
+
 * fix javascript error about non existing zoom div -- tobi
 
 * Switch to curl --help since some distros seem to compile without --manual
diff --git a/htdocs/cropper/smokeping-zoom.js b/htdocs/cropper/smokeping-zoom.js
index 476fcdf..cf69310 100644
--- a/htdocs/cropper/smokeping-zoom.js
+++ b/htdocs/cropper/smokeping-zoom.js
@@ -48,6 +48,7 @@ function changeRRDImage(coords,dimensions){
     var DivEpoch = EndEpoch - StartEpoch; 
 
     var Target = $F('target');
+    var Hierarchy = $F('hierarchy');
 
     // construct Image URL
     var myURLObj = new urlObj(document.URL); 
@@ -69,7 +70,7 @@ function changeRRDImage(coords,dimensions){
     EndEpoch  =  Math.ceil(EndEpoch + (SelectRight - (RRDImgWidth - RRDRight) ) * DivEpoch / RRDImgUsable * RightFactor);
 
 
-    $('zoom').src = myURL + '?displaymode=a;start=' + StartEpoch + ';end=' + EndEpoch + ';target=' + Target;
+    $('zoom').src = myURL + '?displaymode=a;start=' + StartEpoch + ';end=' + EndEpoch + ';target=' + Target + (Hierarchy != '' ? ';hierarchy=' + Hierarchy : '');    
 
     myCropper.setParams();
 
diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm
index 57be935..3c76cca 100644
--- a/lib/Smokeping.pm
+++ b/lib/Smokeping.pm
@@ -130,16 +130,20 @@ sub cgiurl {
     return $url_of{$linkstyle};
 }
 
+sub hierarchy ($){
+    my $q = shift;
+    my $hierarchy = '';
+    if ($q->param('hierarchy')){
+       $hierarchy = 'hierarchy='.$q->param('hierarchy').';';
+    }; 
+    return $hierarchy;
+}        
 sub lnk ($$) {
     my ($q, $path) = @_;
     if ($q->isa('dummyCGI')) {
         return $path . ".html";
     } else {
-        my $hierarchy = '';
-        if ($q->param('hierarchy')){
-            my $hierarchy = 'hierarchy='.$q->param('hierarchy').';';
-        }
-        return cgiurl($q, $cfg) . "?${hierarchy}target=" . $path;
+        return cgiurl($q, $cfg) . "?".hierarchy($q)."target=" . $path;
     }
 }
 
@@ -432,6 +436,10 @@ sub init_target_tree ($$$$) {
     # fill in menu and title if missing
     $tree->{menu} ||=  $tree->{host} || "unknown";
     $tree->{title} ||=  $tree->{host} || "unknown";
+    my $real_path = $name;
+    my $dataroot = $cfg->{General}{datadir};
+    $real_path =~ s/^$dataroot\/*//;
+    my @real_path = split /\//, $real_path;
 
     foreach my $prop (keys %{$tree}) {
         if (ref $tree->{$prop} eq 'HASH'){
@@ -457,10 +465,9 @@ sub init_target_tree ($$$$) {
                         $point = $point->{$item};
                     };
                     $point->{$prop}{__tree_link} = $tree->{$prop};
+	            $point->{$prop}{__real_path} = [ @real_path,$prop ];
                 }
-            }
-               
-
+            }               
             init_target_tree $cfg, $probes, $tree->{$prop}, "$name/$prop";
         }
         if ($prop eq 'host' and check_filter($cfg,$name) and $tree->{$prop} !~ m|^/|) {           
@@ -591,7 +598,7 @@ sub target_menu($$$;$){
     my $current =  shift @{$open} || "";
     my @hashes;
     if (not defined $tree->{_order}){
-        foreach my $prop ( sort grep { ref $tree->{$_} eq 'HASH' } keys %{$tree}) {
+        foreach my $prop ( sort grep { ref $tree->{$_} eq 'HASH' and  not /^__/} keys %{$tree}) {
             push @hashes, $prop;
         }
     } else {
@@ -613,7 +620,12 @@ sub target_menu($$$;$){
         } else {
             $class = 'menuitem';
         };
-        my $menu = $tree->{$_}{menu};
+	my $menu = $_;
+        if ($tree->{__tree_link}){
+	    $menu = $tree->{$_}{__tree_link}{menu};
+	} elsif ($tree->{$_}{menu}){	
+            $menu = $tree->{$_}{menu};
+        };
         $menu =~ s/ / /g;
         my $menuadd ="";
         $menuadd = "&nbsp;" x (20 - length($menu)) if length($menu) < 20;
@@ -682,18 +694,9 @@ sub get_overview ($$$$){
     my $q = shift;
     my $tree = shift;
     my $open = shift;
-    my $dir = "";
 
     my $page ="";
 
-    for (@$open) {
-        $dir .= "/$_";
-        mkdir $cfg->{General}{imgcache}.$dir, 0755 
-            unless -d  $cfg->{General}{imgcache}.$dir;
-        die "ERROR: creating  $cfg->{General}{imgcache}$dir: $!\n"
-                unless -d  $cfg->{General}{imgcache}.$dir;
-    }
-
     my $date = $cfg->{Presentation}{overview}{strftime} ? 
         POSIX::strftime($cfg->{Presentation}{overview}{strftime},
                         localtime(time)) : scalar localtime(time);
@@ -701,22 +704,40 @@ sub get_overview ($$$$){
     if ( $RRDs::VERSION >= 1.199908 ){
             $date =~ s|:|\\:|g;
     }
-    foreach my $prop (sort {$tree->{$a}{_order} <=> $tree->{$b}{_order}} 
-                      grep {  ref $tree->{$_} eq 'HASH' and defined $tree->{$_}{host}}
+    foreach my $prop (sort {$tree->{$a}{_order} ? ($tree->{$a}{_order} <=> $tree->{$b}{_order}) : ($a cmp $b)} 
+                      grep {  ref $tree->{$_} eq 'HASH' and not /^__/ }
                       keys %$tree) {
         my @slaves = ("");
-
-	if ($tree->{$prop}{host} =~ m|^/|){            # multi host syntax
-            @slaves = split /\s+/, $tree->{$prop}{host};
+        my $phys_tree = $tree->{$prop};
+	my $phys_open = $open;
+	my $dir = "";
+	if ($tree->{$prop}{__tree_link}){
+            $phys_tree = $tree->{$prop}{__tree_link};
+	    $phys_open = [ @{$tree->{$prop}{__real_path}} ];
+	    pop @$phys_open;
+	}
+
+	next unless $phys_tree->{host};
+
+	if ($phys_tree->{host} =~ m|^/|){            # multi host syntax
+            @slaves = split /\s+/, $phys_tree->{host};
         }
-        elsif ($tree->{$prop}{slaves}){
-            push @slaves, split /\s+/,$tree->{$prop}{slaves};       
+        elsif ($phys_tree->{slaves}){
+            push @slaves, split /\s+/,$phys_tree->{slaves};       
         } 
 
+        for (@$phys_open) {
+            $dir .= "/$_";
+            mkdir $cfg->{General}{imgcache}.$dir, 0755 
+                unless -d  $cfg->{General}{imgcache}.$dir;
+            die "ERROR: creating  $cfg->{General}{imgcache}$dir: $!\n"
+                unless -d  $cfg->{General}{imgcache}.$dir;
+        }
+
         my @G; #Graph 'script'
         my $max =  $cfg->{Presentation}{overview}{max_rtt} || "100000";
-        my $probe = $probes->{$tree->{$prop}{probe}};
-        my $pings = $probe->_pings($tree->{$prop});
+        my $probe = $probes->{$phys_tree->{probe}};
+        my $pings = $probe->_pings($phys_tree);
         my $i = 0;
         my @colors = split /\s+/, $cfg->{Presentation}{multihost}{colors};
         my $ProbeUnit = $probe->ProbeUnit();
@@ -789,7 +810,7 @@ sub get_overview ($$$$){
           ($cfg->{General}{imgcache}.$dir."/${prop}_mini.png",
     #       '--lazy',
            '--start','-'.exp2seconds($cfg->{Presentation}{overview}{range}),
-           '--title',$tree->{$prop}{title},
+           '--title',$phys_tree->{title},
            '--height',$cfg->{Presentation}{overview}{height},
            '--width',$cfg->{Presentation}{overview}{width},
            '--vertical-label', $ProbeUnit,
@@ -898,11 +919,20 @@ sub get_detail ($$$$;$){
     my $q = shift;
     my $tree = shift;
     my $open = shift;
+    if ($tree->{__tree_link}){
+	$tree=$tree->{__tree_link};
+    }
+
     my $mode = shift || $q->param('displaymode') || 's';
     if ($tree->{host} and $tree->{host} =~ m|^/|){
         return Smokeping::Graphs::get_multi_detail($cfg,$q,$tree,$open,$mode);
     }
 
+    my $open_phys = $open;    
+    if ($tree->{__real_path}){
+	$open_phys = $tree->{__real_path};
+    }
+
     my @slaves = ("");
     if ($tree->{slaves} and $mode eq 's'){
         push @slaves, split /\s+/,$tree->{slaves};       
@@ -910,8 +940,9 @@ sub get_detail ($$$$;$){
  
     return "" unless $tree->{host};
     
-    my @dirs = @{$open};
-    my $file = $mode eq 'c' ? (split(/~/, pop @dirs))[0] : pop @dirs;
+    my $file = $mode eq 'c' ? (split(/~/, $open->[-1]))[0] : $open->[-1];
+    my @dirs = @{$open_phys};
+    pop @dirs;
     my $dir = "";
 
     return "<div>ERROR: ".(join ".", @dirs)." has no probe defined</div>"
@@ -1267,6 +1298,7 @@ sub get_detail ($$$$;$){
            $page .= $q->start_form(-method=>'GET', -id=>'range_form')
               . "<p>Time range: "
               . $q->hidden(-name=>'epoch_start',-id=>'epoch_start',-default=>$start)
+              . ($q->param('hierarchy') ? $q->hidden(-name=>'hierarchy',-id=>'hierarchy') : '')
               . $q->hidden(-name=>'epoch_end',-id=>'epoch_end',-default=>time())
               . $q->hidden(-name=>'target',-id=>'target' )
               . $q->hidden(-name=>'displaymode',-default=>$mode )
@@ -1285,7 +1317,7 @@ sub get_detail ($$$$;$){
 #           $page .= (time-$timer_start)."<br/>";
 #           $page .= join " ",map {"'$_'"} @task;
                 $page .= "<br/>";
-                $page .= ( qq{<a href="?displaymode=n;start=$startstr;end=now;}."target=".$q->param('target').$s.'">'
+                $page .= ( qq{<a href="?}.hierarchy($q).qq{displaymode=n;start=$startstr;end=now;}."target=".$q->param('target').$s.'">'
                       . qq{<IMG BORDER="0" SRC="${imghref}${s}_${end}_${start}.png">}."</a>" ); #"
                 $page .= "</div>";
             }
@@ -1384,11 +1416,36 @@ sub load_sortercache($){
     return ( $found ? \%cache : undef )
 }
 
+sub hierarchy_switcher($$){
+    my $q = shift;
+    my $cfg = shift;
+    my $print ="";
+    if ($cfg->{Presentation}{hierarchies}){
+            $print .= "<br/><br/><div id='hierarchy_title'><small>Hierarchy:</small></div>";
+	    $print .= "<div id='hierarchy_popup'>".$q->start_form(-name=>'hswitch',-method=>'get',-action=>$q->url(-relative=>1));
+	    $print .= $q->popup_menu(-name=>'hierarchy',
+			             -onChange=>'hswitch.submit()',
+            		             -values=>['', sort map {ref $cfg->{Presentation}{hierarchies}{$_} eq 'HASH' 
+                                                 ? $_ : () } keys %{$cfg->{Presentation}{hierarchies}}],
+            		             -labels=>{''=>'Default Hierarchy',
+					       map {ref $cfg->{Presentation}{hierarchies}{$_} eq 'HASH' 
+                                                    ? ($_ => $cfg->{Presentation}{hierarchies}{$_}{title} )
+                                                    : () } keys %{$cfg->{Presentation}{hierarchies}}
+					      }
+				    );
+	    $print .= $q->end_form();
+	$print .= "</div>";
+    }
+    return $print;
+}
+
 sub display_webpage($$){
     my $cfg = shift;
     my $q = shift;
     my ($path,$slave) = split(/~/,$q->param('target') || '');
     my $hierarchy = $q->param('hierarchy');
+    die "ERROR: unknown hierarchy $hierarchy\n" 
+	if not $cfg->{Presentation}{hierarchies} and $cfg->{Presentation}{hierarchies}{$hierarchy};
     my $open = [ (split /\./,$path) ];
     my $open_orig = [@$open];
     $open_orig->[-1] .= '~'.$slave if $slave;
@@ -1402,7 +1459,7 @@ sub display_webpage($$){
     my $step = $cfg->{__probes}{$targets->{probe}}->step();
     # lets see if the charts are opened
     my $charts = 0;
-    $charts = 1 if defined $cfg->{Presentation}{charts} and $open->[0] and $open->[0] eq '__charts';
+    $charts = 1 if defined $cfg->{Presentation}{charts} and $open->[0] and $open->[0] eq '_charts';
     if ($charts and ( not defined $cfg->{__sortercache} 
                       or $cfg->{__sortercachekeeptime} < time )){
        # die "ERROR: Chart $open->[1] does not exit.\n"
@@ -1417,10 +1474,6 @@ sub display_webpage($$){
          last unless  ref $tree->{$_} eq 'HASH';
          $tree = $tree->{$_};
        }
-       # we are in a hierarchy. Point to the original tree
-       if (exists $tree->{__tree_link}){
-           $tree = $tree->{__tree_link};
-       }
     }
     gen_imgs($cfg); # create logos in imgcache
     my $readversion = "?";
@@ -1429,10 +1482,10 @@ sub display_webpage($$){
     my $hierarchy_arg = '';
 
         
-    if (defined $cfg->{Presentation}{charts}){
+    if (defined $cfg->{Presentation}{charts} and not $hierarchy){
         my $order = 1;
-        $targets = { %{$targets},
-                    __charts => {
+        $menu_root = { %{$menu_root},
+                       _charts => {
                         _order => -99,
                         menu => $cfg->{Presentation}{charts}{menu},
                         map { $_ => { menu => $cfg->{Presentation}{charts}{$_}{menu}, _order => $order++ } } 
@@ -1446,18 +1499,22 @@ sub display_webpage($$){
         $hierarchy_arg = 'hierarchy='.$hierarchy.';';
 
     };
+    # if we are in a hierarchy, recover the original path
+
+    my $display_tree = $tree->{__tree_link} ? $tree->{__tree_link} : $tree;
+
     my $page = fill_template
       ($cfg->{Presentation}{template},
        {
         menu => target_menu( $menu_root,
                              [@$open], #copy this because it gets changed
-                             cgiurl($q, $cfg) ."?${hierarchy_arg}target="),
-
-        title => $charts ? "" : $tree->{title},
-        remark => $charts ? "" : ($tree->{remark} || ''),
+                             cgiurl($q, $cfg) ."?${hierarchy_arg}target=").
+		hierarchy_switcher($q,$cfg),
+        title => $charts ? "" : $display_tree->{title},
+        remark => $charts ? "" : ($display_tree->{remark} || ''),
         overview => $charts ? get_charts($cfg,$q,$open) : get_overview( $cfg,$q,$tree,$open),
         body => $charts ? "" : get_detail( $cfg,$q,$tree,$open_orig ),
-        target_ip => $charts ? "" : ($tree->{host} || ''),
+        target_ip => $charts ? "" : ($display_tree->{host} || ''),
         owner => $cfg->{General}{owner},
         contact => $cfg->{General}{contact},
 
@@ -1475,7 +1532,6 @@ sub display_webpage($$){
                      -charset=> ( $cfg->{Presentation}{charset} || 'iso-8859-15'),
                      -Content_length => length($page),
                      );
-
     print $page || "<HTML><BODY>ERROR: Reading page template".$cfg->{Presentation}{template}."</BODY></HTML>";
 
 }
diff --git a/lib/Smokeping/Graphs.pm b/lib/Smokeping/Graphs.pm
index 284ab33..2a2894b 100644
--- a/lib/Smokeping/Graphs.pm
+++ b/lib/Smokeping/Graphs.pm
@@ -34,9 +34,13 @@ sub get_multi_detail ($$$$;$){
     my $tree = shift;
     my $open = shift;
     my $mode = shift || $q->param('displaymode') || 's';
+    my $open_phys = $open;
+    if ($tree->{__real_path}){         
+        $open_phys = $tree->{__real_path};
+    }
 
     
-    my @dirs = @{$open};
+    my @dirs = @{$open_phys};
 
     return "<div>ERROR: ".(join ".", @dirs)." has no probe defined</div>"
         unless $tree->{probe};
@@ -291,6 +295,7 @@ sub get_multi_detail ($$$$;$){
               . $q->hidden(-name=>'epoch_start',-id=>'epoch_start',-default=>$start)
               . $q->hidden(-name=>'epoch_end',-id=>'epoch_end',-default=>time())
               . $q->hidden(-name=>'target',-id=>'target' )
+              . $q->hidden(-name=>'hierarchy',-id=>'hierarchy' )
               . $q->hidden(-name=>'displaymode',-default=>$mode )
               . "&nbsp;"
               . $q->submit(-name=>'Generate!')
diff --git a/lib/Smokeping/Master.pm b/lib/Smokeping/Master.pm
index e54a264..4a5cd90 100644
--- a/lib/Smokeping/Master.pm
+++ b/lib/Smokeping/Master.pm
@@ -1,7 +1,7 @@
 # -*- perl -*-
 package Smokeping::Master;
 use Data::Dumper;
-use Storable qw(nstore_fd dclone fd_retrieve);
+use Storable qw(nstore dclone retrieve);
 use strict;
 use warnings;
 use Fcntl qw(:flock);
@@ -105,30 +105,27 @@ sub save_updates {
                  " in the local data structure. Make sure you run the ".
                  "smokeping daemon. ($cfg->{General}{datadir})\n";
         } 
-        elsif ( open (my $hand, '+>>' , $file) ) {
-            for (my $i = 10; $i < 0; $i--){
-                if ( flock $hand, LOCK_EX ){
+        elsif ( open (my $lock, '>>' , "$file.lock") ) {
+            for (my $i = 10; $i > 0; $i--){
+                if ( flock $lock, LOCK_EX ){
                     my $existing = [];
-                    if ( (stat($hand))[7] > 0 ){
-                        seek $hand, 0,0;
-                        eval { $existing = fd_retrieve $hand };
+	            if ( -r $file ){
+                        my $in = eval { retrieve $file };
                         if ($@) { #error
                             warn "Loading $file: $@";
-                            $existing = [];
-                        }
+                        } else {
+		            $existing = $in;
+			};
                     };
                     push @{$existing}, [ $slave, $time, $updatestring];
-                    seek $hand, 0,0;
-                    truncate $hand, 0;
-                    nstore_fd ($existing, $hand);
-                    flock $hand, LOCK_UN;                
+                    nstore($existing, $file);		    
                     last;
                 } else {
                     warn "Could not lock $file. Trying again for $i rounds.\n";
                     sleep rand(3);
                 }
             }
-            close $hand;
+            close $lock;
         } else {
             warn "Could not update $file: $!";
         }
@@ -145,20 +142,18 @@ sub get_slaveupdates {
     my $name = shift;
     my $file = $name.".slave_cache";
     my $data;
-    if ( open (my $hand, '+<', $file) ) {
-        if ( flock $hand, LOCK_EX ){
-            rename $file,$file.$$;
-            eval { $data = fd_retrieve $hand };
-            unlink $file.$$;
-            flock $hand, LOCK_UN;            
+    if ( -r $file and open (my $lock, '>>', "$file.lock") ) {
+        if ( flock $lock, LOCK_EX ){
+            eval { $data = retrieve $file };
+            unlink $file;
             if ($@) { #error
                 warn "Loading $file: $@";  
-                return;
+                return undef;
             }
         } else {
             warn "Could not lock $file. Will skip and try again in the next round. No harm done!\n";
         }
-        close $hand;        
+        close $lock;        
         return $data;
     }
     return;