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;

#!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();

package Node;
 
use Moose 0.89;
 
has child => (
  is  => 'rw',
  isa => 'Node',
  clearer   => 'clear_child',
  predicate => 'has_child',
  trigger   => \&_child_trigger,
);
has parent => (
  is  => 'rw',
  isa => 'Node',
  clearer   => 'clear_parent',
  predicate => 'has_parent',
);
 
before clear_child => sub {
  my ($self) = @_;
 
  # Trigger dissociate the parent from the child about to be cleared
  $self->_child_trigger(undef, $self->child);
 
  return;
};
 
sub _child_trigger {
  my ($self, $child, $previous_child) = @_;
 
  if (defined $previous_child) {
    # Remove this node as the parent of the previous child
    $previous_child->clear_parent();
  }
 
  if (defined $child) {
    # Set this node as the parent of the new child
    $child->parent($self);
  }
 
  return;
}
 
no Moose;
 
1;

use 5.008003;
use strict;
use warnings 'all';
 
use Carp qw(croak);
use English qw(-no_match_vars);
use Net::SAJAX;
use Scalar::Util qw(blessed);
 
my $sajax = Net::SAJAX->new(
  url => 'http://example.net/directory.php',
);
 
# Look up a person in the directory
my $people = eval {
  $sajax->call(
    function  => 'SearchDirectory',
    arguments => [$first_name, $last_name],
  );
};
 
if ($EVAL_ERROR) { # Remember, $EVAL_ERROR cam from the English module
  # An error occurred
  if (blessed $EVAL_ERROR && $EVAL_ERROR->isa('Net::SAJAX::RemoteError')) {
    # The server sent an error message, like "Access Denied"
    show_error($EVAL_ERROR->message);
  }
  elsif (blessed $EVAL_ERROR && $EVAL_ERROR->isa('Net::SAJAX::JavaScriptEvaluation')) {
    # Some error occurred while evaluating the JavaScript
    # Perform some clean up to the JS because you know that the
    # site returns bad JS sometimes.
    $people = my_own_js_eval($EVAL_ERROR->javascript_string);
  }
  else {
    # Don't know what this error is, so throw it again
    croak $EVAL_ERROR;
  }
}
 
print "Found the following people:\n";
 
# Loop through each person and print
foreach my $person (@{$people}) {
  printf "%s, %s: %s\n",
    $person->{last_name   },
    $person->{first_name  },
    $person->{phone_number};
}
 
sub my_own_js_eval {
  my ($javascript) = @_;
 
  # Do something with the JavaScript here
 
  return [];
}
sub show_error {
  my ($message) = @_;
 
  print {*STDERR} "Received $message from the server!\n";
 
  exit 1;
}
 
exit 0;