Anyhow, in Windows Vista and up the User Account Control feature has a backwards-compatibility feature where for programs that don’t contain manifest files (presumably because they aren’t UAC-aware) Windows will look at certain characteristics of the file to determine if it needs Administrative privileges to run properly. One of the ways it determines this is by file name. The utility that comes with the C tool chain in Strawberry Perl patch.exe triggers this detection mechanism because of the word “patch” in the file name. Because of this it is pretty much impossible to install modules like Math::Pari that make use of the patch.exe program.

A few days ago I saw a new development release of Win32::Exe (0.12_03) was released and saw it supported viewing and modifying of embedded manifests! I decided to use this on the patch.exe file in Strawberry Perl to set the required privilege level to asInvoker (so that UAC is not needed) and it worked! Though you no longer need to do this for the April 2010 and up Strawberry Perl releases, anyone running an older version and not planning to upgrade soon may want to modify their path.exe with the following commands:

C:\> cpan MDOOTSON/Win32-Exe-0.12_03.tar.gz
C:\> perl -MWin32::Exe -e "$e=Win32::Exe->new('c:/strawberry/c/bin/patch.exe'); $m=$e->get_manifest; $m->set_execution_level('asInvoker'); $e->set_manifest($m); $e->write;"

My current thoughts on support for getting performance data from the remote page would be to just scrape it from the standard plugin output, which is supported as the body:

PLUGIN OK - Good to go! | time=0.012s;1;10;10;0

I was also thinking about how to add support for receiving as headers, since the other supported aspects of the plugin may be transmitted as headers. My current thoughts are for a header named X-Nagios-Performance which would hold the name=value pair, separated by spaces like the normal plugin and would also allow more than one header with the data to be present:

X-Nagios-Performance: time=0.012s;1;10;10;0
X-Nagios-Performance: count=2;;;50;0 other=4;;;4;0

For Nagios::Plugin::OverHTTP itself, since the remote plugin can provide critical and warning thresholds, I was thinking of allowing for actually changing the status based on that to be made optional by default (because if the remote plugin said the status was OK but yet a performance metric it sent said that it should really be in a WARNING state, by default Nagios would have kept that as OK so I believe that my plugin should honor that as well by default). New options for the plugin would be:

--warning name=threshold
--critical name=threshold
--use-transmitted-thresholds
--override-transmitted-thresholds

The last option --override-transmitted-thresholds would cause the performance data written as the plugin’s output to be changed to match the thresholds given as the plugin’s options. This means a plugin with the given options --override-transmitted-thresholds --critical time=4 would cause the performance data to say time=0.012s;1;4;10;0 instead of time=0.012s;1;10;10;0 (note that this setting does not affect the decision of the final status code).

The goal of Test::Override::UserAgent is to be able to write response overrides easily. The module allows for the author to create a class consisting of only definitions for overrides so the override definitions do not have to be repeated in each test file. An example override class would look like:

package t::CustomUA;
 
use 5.008;
use Test::Override::UserAgent for => 'configuration';
 
# Disable live requests (the default, anyhow)
allow_live(0);
 
override_request
  host => 'localhost',
  path => '/test',
  sub {
    return [200, ['content-type' => 'text/plain'], ['Test response']];
  };
 
1;

This will cause requests that have a host of localhost and a path of /test to get a response back of text/plain with the Test response body. This configuration can then be used in a test file:

#!perl -T
 
use 5.008;
use Test::More tests => 1;
use t::CustomUA;
 
use My::Module; # Your awesome module to test
 
my $object = new_ok 'My::Module';
 
# Your module has a way to set the user agent it uses
t::CustomUA->configuration->install_in_user_agent($object->user_agent);
 
# Perhaps your module has no way to set the user agent
# or there is something down stream that uses a user agent.
my $scope = t::CustomUA->configuration->install_in_scope;
 
# Do tests that make requests by LWP::UserAgent
 
# End the scope override
undef $scope;

#!/usr/bin/perl
 
package Directory;
 
use 5.008;
use strict;
use warnings 'all';
 
use base 'CGI::Application';
 
use JSON 2.00; # The API was changed
use Try::Tiny;
use WWW::USF::Directory;
 
sub setup {
	my ($self) = @_;
 
	# Create a directory object for use later
	$self->{directory} = WWW::USF::Directory->new(
		include_faculty  => 1,
		include_staff    => 1,
		include_students => 0,
	);
 
	# Start in search mode, which is the only mode
	$self->start_mode('search');
	$self->run_modes(search => 'search');
}
 
sub search {
	my ($self) = @_;
 
	# Hold the results and response
	my (@results, $response);
 
	# Set the header to specity JSON
	$self->header_add(-type => 'application/json');
 
	try {
		# Search the directory
		@results = $self->{directory}->search(
			name => scalar $self->query->param('name'),
		);
 
		foreach my $result (@results) {
			# Change the ::Directory::Entry object into a hash of its attributes
			$result = _moose_object_as_hash($result);
 
			if (exists $result->{affiliations}) {
				$result->{affiliations} = [map {
					_moose_object_as_hash($_);
				} @{$result->{affiliations}}];
			}
		}
 
		# Return the JSON-encoded results to print
		$response = JSON->new->encode({
			results => \@results,
		});
	}
	catch {
		# Get the error
		my $error = $_;
 
		# Return a JSON with the error
		$response = JSON->new->encode({
			error   => "$error",
			results => [],
		});
	};
 
	# Return the response
	return $response;
}
 
sub _moose_object_as_hash {
	my ($object) = @_;
 
	# Convert a Moose object to a HASH with the attribute_name => attribute_value
	my $hash = { map {
		($_->name, $_->get_value($object))
	} $object->meta->get_all_attributes };
 
	return $hash;
}
 
1;
 
package main;
 
use 5.008;
use strict;
use warnings 'all';
 
# Start and tun the application
Directory->new->run();

This will actually be added as an example in the next release. You can run this as a CGI and use the name param to pass what to search for, or run it from the command line with name="Name".