[Bio] / FigKernelPackages / Tracer.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/Tracer.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.48, Thu Jun 8 13:54:49 2006 UTC revision 1.66, Tue Sep 26 13:37:07 2006 UTC
# Line 31  Line 31 
31      use File::Basename;      use File::Basename;
32      use File::Path;      use File::Path;
33      use File::stat;      use File::stat;
34        use LWP::UserAgent;
35        use Time::HiRes 'gettimeofday';
36        use URI::Escape;
37    
38  =head1 Tracing and Debugging Helpers  =head1 Tracing and Debugging Helpers
39    
# Line 1348  Line 1351 
1351      return @inputList;      return @inputList;
1352  }  }
1353    
1354    =head3 Percent
1355    
1356    C<< my $percent = Tracer::Percent($number, $base); >>
1357    
1358    Returns the percent of the base represented by the given number. If the base
1359    is zero, returns zero.
1360    
1361    =over 4
1362    
1363    =item number
1364    
1365    Percent numerator.
1366    
1367    =item base
1368    
1369    Percent base.
1370    
1371    =item RETURN
1372    
1373    Returns the percentage of the base represented by the numerator.
1374    
1375    =back
1376    
1377    =cut
1378    
1379    sub Percent {
1380        # Get the parameters.
1381        my ($number, $base) = @_;
1382        # Declare the return variable.
1383        my $retVal = 0;
1384        # Compute the percent.
1385        if ($base != 0) {
1386            $retVal = $number * 100 / $base;
1387        }
1388        # Return the result.
1389        return $retVal;
1390    }
1391    
1392  =head3 GetFile  =head3 GetFile
1393    
1394  C<< my @fileContents = Tracer::GetFile($fileName); >>  C<< my @fileContents = Tracer::GetFile($fileName); >>
# Line 1381  Line 1422 
1422      # Declare the return variable.      # Declare the return variable.
1423      my @retVal = ();      my @retVal = ();
1424      # Open the file for input.      # Open the file for input.
1425      my $ok = open INPUTFILE, "<$fileName";      my $handle = Open(undef, "<$fileName");
     if (!$ok) {  
         # If we had an error, trace it. We will automatically return a null value.  
         Trace("Could not open \"$fileName\" for input: $!") if T(0);  
     } else {  
1426          # Read the whole file into the return variable, stripping off any terminator          # Read the whole file into the return variable, stripping off any terminator
1427          # characters.          # characters.
1428          my $lineCount = 0;          my $lineCount = 0;
1429          while (my $line = <INPUTFILE>) {      while (my $line = <$handle>) {
1430              $lineCount++;              $lineCount++;
1431              $line = Strip($line);              $line = Strip($line);
1432              push @retVal, $line;              push @retVal, $line;
1433          }          }
1434          # Close it.          # Close it.
1435          close INPUTFILE;      close $handle;
1436          my $actualLines = @retVal;          my $actualLines = @retVal;
     }  
1437      # Return the file's contents in the desired format.      # Return the file's contents in the desired format.
1438      if (wantarray) {      if (wantarray) {
1439          return @retVal;          return @retVal;
# Line 1406  Line 1442 
1442      }      }
1443  }  }
1444    
1445    =head3 PutFile
1446    
1447    C<< Tracer::PutFile($fileName, \@lines); >>
1448    
1449    Write out a file from a list of lines of text.
1450    
1451    =over 4
1452    
1453    =item fileName
1454    
1455    Name of the output file.
1456    
1457    =item lines
1458    
1459    Reference to a list of text lines. The lines will be written to the file in order, with trailing
1460    new-line characters. Alternatively, may be a string, in which case the string will be written without
1461    modification.
1462    
1463    =back
1464    
1465    =cut
1466    
1467    sub PutFile {
1468        # Get the parameters.
1469        my ($fileName, $lines) = @_;
1470        # Open the output file.
1471        my $handle = Open(undef, ">$fileName");
1472        if (ref $lines ne 'ARRAY') {
1473            # Here we have a scalar, so we write it raw.
1474            print $handle $lines;
1475        } else {
1476            # Write the lines one at a time.
1477            for my $line (@{$lines}) {
1478                print $handle "$line\n";
1479            }
1480        }
1481        # Close the output file.
1482        close $handle;
1483    }
1484    
1485  =head3 QTrace  =head3 QTrace
1486    
1487  C<< my $data = QTrace($format); >>  C<< my $data = QTrace($format); >>
# Line 1606  Line 1682 
1682    
1683  =head3 AddToListMap  =head3 AddToListMap
1684    
1685  C<< Tracer::AddToListMap(\%hash, $key, $value); >>  C<< Tracer::AddToListMap(\%hash, $key, $value1, $value2, ... valueN); >>
1686    
1687  Add a key-value pair to a hash of lists. If no value exists for the key, a singleton list  Add a key-value pair to a hash of lists. If no value exists for the key, a singleton list
1688  is created for the key. Otherwise, the new value is pushed onto the list.  is created for the key. Otherwise, the new value is pushed onto the list.
# Line 1621  Line 1697 
1697    
1698  Key for which the value is to be added.  Key for which the value is to be added.
1699    
1700  =item value  =item value1, value2, ... valueN
1701    
1702  Value to add to the key's value list.  List of values to add to the key's value list.
1703    
1704  =back  =back
1705    
# Line 1631  Line 1707 
1707    
1708  sub AddToListMap {  sub AddToListMap {
1709      # Get the parameters.      # Get the parameters.
1710      my ($hash, $key, $value) = @_;      my ($hash, $key, @values) = @_;
1711      # Process according to whether or not the key already has a value.      # Process according to whether or not the key already has a value.
1712      if (! exists $hash->{$key}) {      if (! exists $hash->{$key}) {
1713          $hash->{$key} = [$value];          $hash->{$key} = [@values];
1714      } else {      } else {
1715          push @{$hash->{$key}}, $value;          push @{$hash->{$key}}, @values;
1716      }      }
1717  }  }
1718    
# Line 1666  Line 1742 
1742          $retVal = 1;          $retVal = 1;
1743      } else {      } else {
1744          # Here debug mode is off, so we generate an error page.          # Here debug mode is off, so we generate an error page.
1745          my $pageString = PageBuilder::Build("<Html/ErrorPage.html", {}, "Html");          my $pageString = PageBuilder::Build("<<Html/ErrorPage.html", {}, "Html");
1746          print $pageString;          print $pageString;
1747      }      }
1748      # Return the determination indicator.      # Return the determination indicator.
# Line 1837  Line 1913 
1913      my $query = CGI->new();      my $query = CGI->new();
1914      # Check for tracing. Set it up if the user asked for it.      # Check for tracing. Set it up if the user asked for it.
1915      if ($query->param('Trace')) {      if ($query->param('Trace')) {
1916          # Set up tracing to be queued for display at the bottom of the web page.          # Set up tracing.
1917          TSetup($query->param('Trace') . " FIG Tracer", "QUEUE");          my $ttype = ($query->param('TF') ? ">$FIG_Config::temp/Trace$$.log" : "QUEUE");
1918            TSetup($query->param('Trace') . " FIG Tracer", $ttype);
1919          # Trace the parameter and environment data.          # Trace the parameter and environment data.
1920            TraceParms($query);
1921        } else {
1922            # Here tracing is to be turned off. All we allow is errors traced into the
1923            # error log.
1924            TSetup("0", "WARN");
1925        }
1926        # Create the variable hash.
1927        my $varHash = { DebugData => '' };
1928        # Return the query object and variable hash.
1929        return ($query, $varHash);
1930    }
1931    
1932    =head3 TraceParms
1933    
1934    C<< Tracer::TraceParms($query); >>
1935    
1936    Trace the CGI parameters at trace level CGI => 3 and the environment variables
1937    at level CGI => 4.
1938    
1939    =over 4
1940    
1941    =item query
1942    
1943    CGI query object containing the parameters to trace.
1944    
1945    =back
1946    
1947    =cut
1948    
1949    sub TraceParms {
1950        # Get the parameters.
1951        my ($query) = @_;
1952          if (T(CGI => 3)) {          if (T(CGI => 3)) {
1953              # Here we want to trace the parameter data.              # Here we want to trace the parameter data.
1954              my @names = $query->param;              my @names = $query->param;
# Line 1857  Line 1966 
1966                  Trace("ENV: $envName = $ENV{$envName}");                  Trace("ENV: $envName = $ENV{$envName}");
1967              }              }
1968          }          }
     } else {  
         # Here tracing is to be turned off. All we allow is errors traced into the  
         # error log.  
         TSetup("0", "WARN");  
     }  
     # Create the variable hash.  
     my $varHash = { DebugData => '' };  
     # If we're in DEBUG mode, set up the debug mode data for forms.  
     if (Tracer::DebugMode) {  
         $varHash->{DebugData} = GetFile("Html/DebugFragment.html");  
     }  
     # Return the query object and variable hash.  
     return ($query, $varHash);  
1969  }  }
1970    
1971  =head3 ScriptFinish  =head3 ScriptFinish
# Line 1933  Line 2029 
2029      # Check for a template file situation.      # Check for a template file situation.
2030      my $outputString;      my $outputString;
2031      if (defined $varHash) {      if (defined $varHash) {
2032          # Here we have a template file. We need to apply the variables to the template.          # Here we have a template file. We need to determine the template type.
2033          $outputString = PageBuilder::Build("<$webData", $varHash, "Html");          my $template;
2034            if ($FIG_Config::template_url && $webData =~ /\.php$/) {
2035                $template = "$FIG_Config::template_url/$webData";
2036            } else {
2037                $template = "<<$webData";
2038            }
2039            $outputString = PageBuilder::Build($template, $varHash, "Html");
2040      } else {      } else {
2041          # Here the user gave us a raw string.          # Here the user gave us a raw string.
2042          $outputString = $webData;          $outputString = $webData;
# Line 2010  Line 2112 
2112      }      }
2113  }  }
2114    
2115    =head3 SendSMS
2116    
2117    C<< my $msgID = Tracer::SendSMS($phoneNumber, $msg); >>
2118    
2119    Send a text message to a phone number using Clickatell. The FIG_Config file must contain the
2120    user name, password, and API ID for the relevant account in the hash reference variable
2121    I<$FIG_Config::phone>, using the keys C<user>, C<password>, and C<api_id>. For
2122    example, if the user name is C<BruceTheHumanPet>, the password is C<silly>, and the API ID
2123    is C<2561022>, then the FIG_Config file must contain
2124    
2125        $phone =  { user => 'BruceTheHumanPet',
2126                    password => 'silly',
2127                    api_id => '2561022' };
2128    
2129    The original purpose of this method was to insure Bruce would be notified immediately when the
2130    Sprout Load terminates. Care should be taken if you do not wish Bruce to be notified immediately
2131    when you call this method.
2132    
2133    The message ID will be returned if successful, and C<undef> if an error occurs.
2134    
2135    =over 4
2136    
2137    =item phoneNumber
2138    
2139    Phone number to receive the message, in international format. A United States phone number
2140    would be prefixed by "1". A British phone number would be prefixed by "44".
2141    
2142    =item msg
2143    
2144    Message to send to the specified phone.
2145    
2146    =item RETURN
2147    
2148    Returns the message ID if successful, and C<undef> if the message could not be sent.
2149    
2150    =back
2151    
2152    =cut
2153    
2154    sub SendSMS {
2155        # Get the parameters.
2156        my ($phoneNumber, $msg) = @_;
2157        # Declare the return variable. If we do not change it, C<undef> will be returned.
2158        my $retVal;
2159        # Only proceed if we have phone support.
2160        if (! defined $FIG_Config::phone) {
2161            Trace("Phone support not present in FIG_Config.") if T(1);
2162        } else {
2163            # Get the phone data.
2164            my $parms = $FIG_Config::phone;
2165            # Get the Clickatell URL.
2166            my $url = "http://api.clickatell.com/http/";
2167            # Create the user agent.
2168            my $ua = LWP::UserAgent->new;
2169            # Request a Clickatell session.
2170            my $resp = $ua->post("$url/sendmsg", { user => $parms->{user},
2171                                         password => $parms->{password},
2172                                         api_id => $parms->{api_id},
2173                                         to => $phoneNumber,
2174                                         text => $msg});
2175            # Check for an error.
2176            if (! $resp->is_success) {
2177                Trace("Alert failed.") if T(1);
2178            } else {
2179                # Get the message ID.
2180                my $rstring = $resp->content;
2181                if ($rstring =~ /^ID:\s+(.*)$/) {
2182                    $retVal = $1;
2183                } else {
2184                    Trace("Phone attempt failed with $rstring") if T(1);
2185                }
2186            }
2187        }
2188        # Return the result.
2189        return $retVal;
2190    }
2191    
2192    =head3 CommaFormat
2193    
2194    C<< my $formatted = Tracer::CommaFormat($number); >>
2195    
2196    Insert commas into a number.
2197    
2198    =over 4
2199    
2200    =item number
2201    
2202    A sequence of digits.
2203    
2204    =item RETURN
2205    
2206    Returns the same digits with commas strategically inserted.
2207    
2208    =back
2209    
2210    =cut
2211    
2212    sub CommaFormat {
2213        # Get the parameters.
2214        my ($number) = @_;
2215        # Pad the length up to a multiple of three.
2216        my $padded = "$number";
2217        $padded = " " . $padded while length($padded) % 3 != 0;
2218        # This is a fancy PERL trick. The parentheses in the SPLIT pattern
2219        # cause the delimiters to be included in the output stream. The
2220        # GREP removes the empty strings in between the delimiters.
2221        my $retVal = join(",", grep { $_ ne '' } split(/(...)/, $padded));
2222        # Clean out the spaces.
2223        $retVal =~ s/ //g;
2224        # Return the result.
2225        return $retVal;
2226    }
2227  =head3 SetPermissions  =head3 SetPermissions
2228    
2229  C<< Tracer::SetPermissions($dirName, $group, $mask); >>  C<< Tracer::SetPermissions($dirName, $group, $mask, %otherMasks); >>
2230    
2231  Set the permissions for a directory and all the files and folders inside it.  Set the permissions for a directory and all the files and folders inside it.
2232  In addition, the group ownership will be changed to the specified value.  In addition, the group ownership will be changed to the specified value.
# Line 2036  Line 2250 
2250  permission bits of any file or directory that does not already have them  permission bits of any file or directory that does not already have them
2251  set to 1.  set to 1.
2252    
2253    =item otherMasks
2254    
2255    Map of search patterns to permission masks. If a directory name matches
2256    one of the patterns, that directory and all its members and subdirectories
2257    will be assigned the new pattern. For example, the following would
2258    assign 01664 to most files, but would use 01777 for directories named C<tmp>.
2259    
2260        Tracer::SetPermissions($dirName, 'fig', 01664, '^tmp$' => 01777);
2261    
2262    The list is ordered, so the following would use 0777 for C<tmp1> and
2263    0666 for C<tmp>, C<tmp2>, or C<tmp3>.
2264    
2265        Tracer::SetPermissions($dirName, 'fig', 01664, '^tmp1' => 0777,
2266                                                       '^tmp' => 0666);
2267    
2268    Note that the pattern matches are all case-insensitive, and only directory
2269    names are matched, not file names.
2270    
2271  =back  =back
2272    
2273  =cut  =cut
2274    
2275  sub SetPermissions {  sub SetPermissions {
2276      # Get the parameters.      # Get the parameters.
2277      my ($dirName, $group, $mask) = @_;      my ($dirName, $group, $mask, @otherMasks) = @_;
2278      # Set up for error recovery.      # Set up for error recovery.
2279      eval {      eval {
2280            # Switch to the specified directory.
2281          ChDir($dirName);          ChDir($dirName);
2282          # Get the group ID.          # Get the group ID.
2283          my $gid = getgrnam($group);          my $gid = getgrnam($group);
2284          Trace("Fixing permissions for directory $dirName using group $group($gid).") if T(2);          # Get the mask for tracing.
2285            my $traceMask = sprintf("%04o", $mask) . "($mask)";
2286            Trace("Fixing permissions for directory $dirName using group $group($gid) and mask $traceMask.") if T(2);
2287          my $fixCount = 0;          my $fixCount = 0;
2288          my $lookCount = 0;          my $lookCount = 0;
2289          # @dirs will be a stack of directories to be processed.          # @dirs will be a stack of directories to be processed.
# Line 2056  Line 2291 
2291          while (scalar(@dirs) > 0) {          while (scalar(@dirs) > 0) {
2292              # Get the current directory.              # Get the current directory.
2293              my $dir = pop @dirs;              my $dir = pop @dirs;
2294              # Get all its non-hidden members.              # Check for a match to one of the specified directory names. To do
2295                # that, we need to pull the individual part of the name off of the
2296                # whole path.
2297                my $simpleName = $dir;
2298                if ($dir =~ m!/([^/]+)$!) {
2299                    $simpleName = $1;
2300                }
2301                Trace("Simple directory name for $dir is $simpleName.") if T(4);
2302                # Search for a match.
2303                my $match = 0;
2304                my $i;
2305                for ($i = 0; $i < $#otherMasks && ! $match; $i += 2) {
2306                    my $pattern = $otherMasks[$i];
2307                    if ($simpleName =~ /$pattern/i) {
2308                        $match = 1;
2309                    }
2310                }
2311                # Check for a match. Note we use $i-1 because the loop added 2
2312                # before terminating due to the match.
2313                if ($match && $otherMasks[$i-1] != $mask) {
2314                    # This directory matches one of the incoming patterns, and it's
2315                    # a different mask, so we process it recursively with that mask.
2316                    SetPermissions($dir, $group, $otherMasks[$i-1], @otherMasks);
2317                } else {
2318                    # Here we can process normally. Get all of the non-hidden members.
2319              my @submems = OpenDir($dir, 1);              my @submems = OpenDir($dir, 1);
2320              for my $submem (@submems) {              for my $submem (@submems) {
2321                  # Get the full name.                  # Get the full name.
# Line 2064  Line 2323 
2323                  Trace("Checking member $thisMem.") if T(4);                  Trace("Checking member $thisMem.") if T(4);
2324                  $lookCount++;                  $lookCount++;
2325                  if ($lookCount % 1000 == 0) {                  if ($lookCount % 1000 == 0) {
2326                      Trace("$lookCount members examined. Current is $thisMem.") if T(3);                          Trace("$lookCount members examined. Current is $thisMem. Mask is $traceMask") if T(3);
2327                  }                  }
2328                  # Fix the group.                  # Fix the group.
2329                  chown -1, $gid, $thisMem;                  chown -1, $gid, $thisMem;
# Line 2076  Line 2335 
2335                      # and we want to skip it anyway.                      # and we want to skip it anyway.
2336                      if ($fileInfo) {                      if ($fileInfo) {
2337                          my $fileMode = $fileInfo->mode;                          my $fileMode = $fileInfo->mode;
2338                          if (($fileMode & $mask) == 0) {                              if (($fileMode & $mask) != $mask) {
2339                              # Fix this member.                              # Fix this member.
2340                              $fileMode |= $mask;                              $fileMode |= $mask;
2341                              chmod $fileMode, $thisMem;                              chmod $fileMode, $thisMem;
# Line 2090  Line 2349 
2349                  }                  }
2350              }              }
2351          }          }
2352            }
2353          Trace("$lookCount files and directories processed, $fixCount fixed.") if T(2);          Trace("$lookCount files and directories processed, $fixCount fixed.") if T(2);
2354      };      };
2355      # Check for an error.      # Check for an error.
# Line 2098  Line 2358 
2358      }      }
2359  }  }
2360    
2361    =head3 CompareLists
2362    
2363    C<< my ($inserted, $deleted) = Tracer::CompareLists(\@newList, \@oldList, $keyIndex); >>
2364    
2365    Compare two lists of tuples, and return a hash analyzing the differences. The lists
2366    are presumed to be sorted alphabetically by the value in the $keyIndex column.
2367    The return value contains a list of items that are only in the new list
2368    (inserted) and only in the old list (deleted).
2369    
2370    =over 4
2371    
2372    =item newList
2373    
2374    Reference to a list of new tuples.
2375    
2376    =item oldList
2377    
2378    Reference to a list of old tuples.
2379    
2380    =item keyIndex (optional)
2381    
2382    Index into each tuple of its key field. The default is 0.
2383    
2384    =item RETURN
2385    
2386    Returns a 2-tuple consisting of a reference to the list of items that are only in the new
2387    list (inserted) followed by a reference to the list of items that are only in the old
2388    list (deleted).
2389    
2390    =back
2391    
2392    =cut
2393    
2394    sub CompareLists {
2395        # Get the parameters.
2396        my ($newList, $oldList, $keyIndex) = @_;
2397        if (! defined $keyIndex) {
2398            $keyIndex = 0;
2399        }
2400        # Declare the return variables.
2401        my ($inserted, $deleted) = ([], []);
2402        # Loop through the two lists simultaneously.
2403        my ($newI, $oldI) = (0, 0);
2404        my ($newN, $oldN) = (scalar @{$newList}, scalar @{$oldList});
2405        while ($newI < $newN || $oldI < $oldN) {
2406            # Get the current object in each list. Note that if one
2407            # of the lists is past the end, we'll get undef.
2408            my $newItem = $newList->[$newI];
2409            my $oldItem = $oldList->[$oldI];
2410            if (! defined($newItem) || defined($oldItem) && $newItem->[$keyIndex] gt $oldItem->[$keyIndex]) {
2411                # The old item is not in the new list, so mark it deleted.
2412                push @{$deleted}, $oldItem;
2413                $oldI++;
2414            } elsif (! defined($oldItem) || $oldItem->[$keyIndex] gt $newItem->[$keyIndex]) {
2415                # The new item is not in the old list, so mark it inserted.
2416                push @{$inserted}, $newItem;
2417                $newI++;
2418            } else {
2419                # The item is in both lists, so push forward.
2420                $oldI++;
2421                $newI++;
2422            }
2423        }
2424        # Return the result.
2425        return ($inserted, $deleted);
2426    }
2427    
2428    =head3 GetLine
2429    
2430    C<< my @data = Tracer::GetLine($handle); >>
2431    
2432    Read a line of data from a tab-delimited file.
2433    
2434    =over 4
2435    
2436    =item handle
2437    
2438    Open file handle from which to read.
2439    
2440    =item RETURN
2441    
2442    Returns a list of the fields in the record read. The fields are presumed to be
2443    tab-delimited. If we are at the end of the file, then an empty list will be
2444    returned. If an empty line is read, a single list item consisting of a null
2445    string will be returned.
2446    
2447    =back
2448    
2449    =cut
2450    
2451    sub GetLine {
2452        # Get the parameters.
2453        my ($handle) = @_;
2454        # Declare the return variable.
2455        my @retVal = ();
2456        # Read from the file.
2457        my $line = <$handle>;
2458        # Only proceed if we found something.
2459        if (defined $line) {
2460            # Remove the new-line.
2461            chomp $line;
2462            # If the line is empty, return a single empty string; otherwise, parse
2463            # it into fields.
2464            if ($line eq "") {
2465                push @retVal, "";
2466            } else {
2467                push @retVal, split /\t/,$line;
2468            }
2469        }
2470        # Return the result.
2471        return @retVal;
2472    }
2473    
2474    =head3 PutLine
2475    
2476    C<< Tracer::PutLine($handle, \@fields); >>
2477    
2478    Write a line of data to a tab-delimited file. The specified field values will be
2479    output in tab-separated form, with a trailing new-line.
2480    
2481    =over 4
2482    
2483    =item handle
2484    
2485    Output file handle.
2486    
2487    =item fields
2488    
2489    List of field values.
2490    
2491    =back
2492    
2493    =cut
2494    
2495    sub PutLine {
2496        # Get the parameters.
2497        my ($handle, $fields) = @_;
2498        # Write the data.
2499        print $handle join("\t", @{$fields}) . "\n";
2500    }
2501    
2502    =head3 GenerateURL
2503    
2504    C<< my $queryUrl = Tracer::GenerateURL($page, %parameters); >>
2505    
2506    Generate a GET-style URL for the specified page with the specified parameter
2507    names and values. The values will be URL-escaped automatically. So, for
2508    example
2509    
2510        Tracer::GenerateURL("form.cgi", type => 1, string => "\"high pass\" or highway")
2511    
2512    would return
2513    
2514        form.cgi?type=1&string=%22high%20pass%22%20or%20highway
2515    
2516    =over 4
2517    
2518    =item page
2519    
2520    Page URL.
2521    
2522    =item parameters
2523    
2524    Hash mapping parameter names to parameter values.
2525    
2526    =item RETURN
2527    
2528    Returns a GET-style URL that goes to the specified page and passes in the
2529    specified parameters and values.
2530    
2531    =back
2532    
2533    =cut
2534    
2535    sub GenerateURL {
2536        # Get the parameters.
2537        my ($page, %parameters) = @_;
2538        # Prime the return variable with the page URL.
2539        my $retVal = $page;
2540        # Loop through the parameters, creating parameter elements in a list.
2541        my @parmList = map { "$_=" . uri_escape($parameters{$_}) } keys %parameters;
2542        # If the list is nonempty, tack it on.
2543        if (@parmList) {
2544            $retVal .= "?" . join("&", @parmList);
2545        }
2546        # Return the result.
2547        return $retVal;
2548    }
2549    
2550  1;  1;

Legend:
Removed from v.1.48  
changed lines
  Added in v.1.66

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3