view release on metacpan or  search on metacpan

lib/WWW/USF/Directory.pm  view on Meta::CPAN

					message     => 'The search returned too many results',
					max_results => $max_results,
				);
			}
		}
		# Determine if the response had no results
		elsif ($heading->textContent eq '0 matches found') {
			# Return nothing
			return;
		}
	}

	# Get the first table in the response
	my $search_results_table = $document->getElementsByTagName('table')->shift;

	if (!defined $search_results_table) {
		# Don't know how to handle the response, so throw exception
		WWW::USF::Directory::Exception->throw(
			class         => 'UnknownResponse',
			message       => 'The response from the server did not contain a results table',
			ajax_response => $search_results_html,
		);
	}

	# Get all the table rows
	my $table_rows = $search_results_table->getChildrenByTagName('tbody')->shift
	                                      ->getChildrenByTagName('tr');

	# Get an array of table headers
	my @table_header = map { _clean_node_text_as_perl_name($_) }
		$table_rows->shift->getChildrenByTagName('td');

	# Get the table's content as array of entries
	my @results = map { _table_row_to_entry($_, \@table_header) }
		$table_rows->get_nodelist;

	return @results;
}
sub _select_node_to_hash {
	my ($select_node) = @_;

	return map { ($_->getAttribute('value'), _clean_node_text($_)) }
		grep { $_->hasAttribute('value') }
		$select_node->getChildrenByTagName('option');
}
sub _table_row_to_entry {
	my ($tr_node, $table_header) = @_;

	# Get the row's text content as an array
	my @row_content = map { _clean_node_text($_) }
		$tr_node->getChildrenByTagName('td');

	# Make a hash with the headers as the keys
	my %row = List::MoreUtils::mesh @{$table_header}, @row_content;

	# Delete all keys with blank content
	delete @row{grep { $row{$_} =~ m{\A \p{IsSpace}* \z}msx } keys %row};

	if (exists $row{given_name}) {
		# Split on vertical whitespace
		my @given_names = split m{[\r\n]+}msx, $row{given_name};

		# The first two given names are as follows
		my ($first_name, $middle_name) = @given_names;

		if (defined $first_name) {
			# Set the first name
			$row{first_name} = $first_name;
		}

		if (defined $middle_name) {
			# Set the middle name
			$row{middle_name} = $middle_name;
		}
	}

	if (exists $row{affiliation}) {
		# There could be zero or more affiliations seperated by vertical space
		my @affiliations = split m{\s*[\r\n]+\s*}msx, delete $row{affiliation};

		# Change the affiliation to objects
		foreach my $affiliation (@affiliations) {
			$affiliation = WWW::USF::Directory::Entry::Affiliation->new($affiliation);
		}

		# Store the affiliations
		$row{affiliations} = \@affiliations;
	}

	# Remove vertical whitespace from all non-reference values
	foreach my $value (values %row) {
		if (ref $value eq q{}) {
			# A string, so remove vertical whitespace
			$value =~ s{\s*[\r\n]+\s*}{ }gmsx;
		}
	}

	if (exists $row{campus_phone}) {
		# Remove all non-letters and non-numbers
		$row{campus_phone} =~ s{[^a-z0-9]+}{}gimsx;

		# Remove the U.S. country code if present
		$row{campus_phone} =~ s{\A \+ 1}{}msx;

		# Reformat the phone number
		$row{campus_phone} =~ s{\A (\d{3}) (\d{3}) (\d{4}) \z}{+1 $1 $2 $3}msx;
	}

	if (exists $row{email}) {
		# USF is not too bright at preventing unwanted text from coming through
		if (List::MoreUtils::any { $_ eq $row{email} } qw[null undefined]) {
			# This is an invalid address
			delete $row{email};
		}
	}

	# Make a new entry for the result
	my $entry = WWW::USF::Directory::Entry->new(%row);

	# Return the entry
	return $entry;
}

###########################################################################
# MAKE MOOSE OBJECT IMMUTABLE
__PACKAGE__->meta->make_immutable;

1;

__END__

=head1 NAME

WWW::USF::Directory - Access to USF's online directory

=head1 VERSION

This documentation refers to version 0.003001