Changeset 39658 for trunk/DataStoreServer/web/cgi/dsgetindex

Timestamp:

Aug 23, 2016, 9:17:22 AM (10 years ago)

Author:

bills

Message:

committing several data store scripts that have been in production
for quite a while but never committed to the source tree

File:

• trunk/DataStoreServer/web/cgi/dsgetindex (modified) (4 diffs)

trunk/DataStoreServer/web/cgi/dsgetindex

@@ -20 +20 @@
 my $PS_EXIT_CONFIG_ERROR = 3;
 my $PS_EXIT_DATA_ERROR = 5;
+
+my $redirect_root_to_pstamp = 0;
 
 my $uri = shift;
@@ -132 +134 @@
             print @$stdout_buf;
         }
+        $error_code = 0 if !defined $error_code;
     } else {
         if (0 && $html_mode) {
@@ -199 +202 @@
 
         # return link
-        print a({-href=>"./index.txt"}, "Text Version");
+        if (!$redirect_root_to_pstamp || $program ne "dsrootindex") {
+            print a({-href=>"./index.txt"}, "Text Version");
+        }
 
         if ($#path >= 1) {
-            print "&nbsp&nbsp&nbsp&nbsp\n";
-
-            my $up = join('/', @path[0..$#path-1]);
-            print a({-href=>".."}, "Up to $up");
-
+            # including the up links in the data store display causes 
+            # wget -r to follow them up which makes a mess
+            # Turn them off if the user agent looks like wget
+            my $display_up_links = (lc($ENV{HTTP_USER_AGENT}) =~ /wget/) ? 0 : 1;
+            if ($display_up_links) {
+                print "&nbsp&nbsp&nbsp&nbsp\n";
+                my $up = join('/', @path[0..$#path-1]);
+                if ($redirect_root_to_pstamp and $program eq "dsprodindex") {
+                    print a({-href=>"http://pstamp.ipp.ifa.hawaii.edu/dsroot.php"}, "Up to $up");
+                } elsif ($program eq 'dsrootindex') {
+                    # no up link in dsroot
+                } else {
+                    print a({-href=>".."}, "Up to $up");
+                }
+            }
         }
         print "</p>\n";
@@ -244 +259 @@
     if ($nolink) {
        print $toks[0];
-    }
-
-    else {
-                # assumes id is always first field
-            my $wpath = "./$toks[0]";
-
-            # if this is a file request, use a download cgi
-            if ($wpath =~ /\.fits\s*$/) {
-                # This doesn't work through the proxy
-                # The /ds-cgi gets tried on alala
-                #    $wpath = '/ds-cgi/dsfits.cgi?'.substr($wpath, 4); # strip' /ds/'
+    } else {
+         # First column is link to an entity down one level in data store (product, fileset, file)
+         # assumes id is always first field
+         my $wpath = "./$toks[0]";
+
+         # if this is a file request, use a download cgi
+         my $fits = 0;
+         if ($wpath =~ /\.fits\s*$/) {
+             # This doesn't work through the proxy
+             # The /ds-cgi gets tried on alala
+             #    $wpath = '/ds-cgi/dsfits.cgi?'.substr($wpath, 4); # strip' /ds/'
+             $fits = 1;
+         }
+
+        if ($fits) {
+            print a({-href=>$wpath, -type=>'image/x-fits'}, $toks[0]);
+        } else {
+            print a({-href=>$wpath}, $toks[0]);
+        }
+
+        if ($program eq 'dsrootindex') {
+            # for root listing make most recent fileset a link as well unless there are no filesets
+            my $fileset = $toks[1];
+            $fileset =~ s/^\s+//;
+            $fileset =~ s/\s+$//;
+            if ($fileset ne 'none') {
+                print "</$celltag>";
+                print "<$celltag>";
+                # drop the product from the list of tokens
+                my $product = shift @toks;
+                # elmiminate any whitesapace
+                $product =~ s/^\s+//;
+                $product =~ s/\s+$//;
+                print a({-href=>"./$product/$fileset"}, $fileset);
             }
-
-        print a({-href=>$wpath, -type=>'image/x-fits'}, $toks[0]);
-    }
+        }
+    }
+    shift @toks;
 
     print "</$celltag>";
 
-    foreach my $val (@toks[1..$#toks]) {
+    # foreach my $val (@toks[1..$#toks]) {
+    foreach my $val (@toks) {
                 print "<$celltag>";
                 print $val;