* Added dispatching of compound object names (e.g. time_entries)

* Fixed handling of irregular pluralization
* Tests updated

lib/RedMiner/API.pm

@@ -4,7 +4,7 @@ use 5.010;
 use strict;
 use warnings;
 
-our $VERSION = '0.02';
+our $VERSION = '0.03';
 
 use URI;
 use URI::QueryParam;
@@ -155,7 +155,7 @@ sub _dispatch_name
 	my $name = shift // return $self->_set_client_error('Undefined method name');
 	my @args = @_;
 
-	my ($action, $objects) = ($name =~ /^(get|read|create|update|delete)?(.+?)$/);
+	my ($action, $objects) = ($name =~ /^(get|read|create|update|delete)?([A-Za-z]+?)$/);
 	
 	if (!$action || $action eq 'read') {
 		$action = 'get';
@@ -164,7 +164,6 @@ sub _dispatch_name
 		return $self->_set_client_error("Malformed method name '$name'");
 	}
 
-	$objects   = ucfirst $objects;
 	my %METHOD = (
 		get    => 'GET'   ,
 		create => 'POST'  ,
@@ -188,29 +187,27 @@ sub _dispatch_name
 		# If last argument is an array/hash reference, treat it as a request body:
 		if (ref $args[-1] ne 'ARRAY' && ref $args[-1] ne 'HASH') {
 			return $self->_set_client_error(
-				'No data provided for create/update query'
+				'No data provided for a create/update method'
 			);
 		}
 		$data->{content} = pop @args;
 	}
 
+	$objects = $self->_normalize_objects($objects);
+
 	my $i = 0;
 	my @objects;
 	while ($objects =~ /([A-Z][a-z]+)/g) {
-		my $object   = lc $1;
-		my $category = $object;
-		
-		# If an object is singular, pluralize to make its category name: user -> users
-		if ($object !~ /s$/) {
-			$category .= 's';
-		}
+		my $object   = $self->_object($1);
+		my $category = $self->_category($object);
 		
 		push @objects, $category;
 
+		next if $object eq $category;
+
 		# We need to attach an object ID to the path if an object is singular and
 		# we either perform anything but creation or we create a new object inside
 		# another object (createProjectMembership)
-		if ($object !~ /s$/) {
 		if ($action ne 'create' || pos($objects) != length($objects)) {
 			my $object_id = $args[$i++];
 
@@ -220,8 +217,9 @@ sub _dispatch_name
 
 			push @objects, $object_id;
 		}
-			if (defined $data->{content} && pos($objects) == length($objects)) {
+
 		# Add wrapping object, if necessary:
+		if (defined $data->{content} && pos($objects) == length($objects)) {
 			if (!exists $data->{content}{$object}) {
 				$data->{content} = {
 					$object => $data->{content}
@@ -229,13 +227,64 @@ sub _dispatch_name
 			}
 		}
 	}
-	}
 	
 	$data->{path} = join '/', @objects;
 
 	return $data;
 }
 
+sub _normalize_objects
+{
+	my $self    = shift;
+	my $objects = shift;
+
+	$objects = ucfirst $objects;
+	# These are token that for a *single* entry in the resulting request path,
+	# e.g.: PUT /time_entries/1.json
+	# But it is natural to spell them like this:
+	# $api->updateTimeEntry(1, { ... });
+	$objects =~ s/TimeEntr/Timeentr/g;
+	$objects =~ s/IssueCategor/Issuecategor/g;
+	$objects =~ s/IssueStatus/Issuestatus/g;
+	$objects =~ s/CustomField/Customfield/g;
+
+	return $objects;
+}
+
+sub _object
+{
+	my $self   = shift;
+	my $object = lc(shift);
+	
+	# Process compound words:
+	$object =~ s/timeentr/time_entr/ig;
+	$object =~ s/issue(categor|status)/issue_$1/ig;
+	$object =~ s/customfield/custom_field/ig;
+	
+	return $object;
+}
+
+# If an object is singular, pluralize to make its category name: user -> users
+sub _category
+{
+	my $self   = shift;
+	my $object = shift;
+
+	my $category = $object;
+
+	if ($category !~ /s$/ || $category =~ /us$/) {
+		if ($object =~ /y$/) {
+			$category =~ s/y$/ies/;
+		} elsif ($category =~ /us$/) {
+			$category .= 'es';
+		} else {
+			$category .= 's';
+		}
+	}
+
+	return $category;
+}
+
 =head1 SEE ALSO
 
 RedMine::API: http://search.cpan.org/~celogeek/Redmine-API-0.04/

t/01-dispatching.t

 use strict;
 use warnings;
 
-use Test::More;
+use Test::More tests => 30;
 
 BEGIN { use_ok('RedMiner::API') };
 
 #
-# Tests for internal dispatching mechanizm
+# Tests for internal name dispatching
 #
 
 my $redminer = RedMiner::API->new(
@@ -154,6 +154,84 @@ is_deeply($r, {
 	query   => undef,
 }, 'createProjectMembership');
 
-done_testing;
+$r = $redminer->_dispatch_name('createIssueWatcher', 1, { user_id => 1 });
+is_deeply($r, {
+	method => 'POST',
+	path   => 'issues/1/watchers',
+	content => { watcher => { user_id => 1 } },
+	query   => undef,
+}, 'createIssueWatcher');
+
+$r = $redminer->_dispatch_name('deleteIssueWatcher', 1, 42);
+is_deeply($r, {
+	method => 'DELETE',
+	path   => 'issues/1/watchers/42',
+	content => undef,
+	query   => undef,
+}, 'deleteIssueWatcher');
+
+#
+# Dispatching methods with compound object names
+#
+
+$r = $redminer->_dispatch_name('timeEntries', { limit => 10, offset => 9 });
+is_deeply($r, {
+	method => 'GET',
+	path   => 'time_entries',
+	content => undef,
+	query   => { limit => 10, offset => 9 },
+}, 'timeEntries');
+
+$r = $redminer->_dispatch_name('timeEntry', 1);
+is_deeply($r, {
+	method => 'GET',
+	path   => 'time_entries/1',
+	content => undef,
+	query   => undef,
+}, 'timeEntry');
+
+$r = $redminer->_dispatch_name('createTimeEntry', { issue_id => 42, hours => 1 });
+is_deeply($r, {
+	method => 'POST',
+	path   => 'time_entries',
+	content => { time_entry => { issue_id => 42, hours => 1 } },
+	query   => undef,
+}, 'createTimeEntry');
+
+$r = $redminer->_dispatch_name('updateTimeEntry', 1, { issue_id => 42, hours => 1 });
+is_deeply($r, {
+	method => 'PUT',
+	path   => 'time_entries/1',
+	content => { time_entry => { issue_id => 42, hours => 1 } },
+	query   => undef,
+}, 'updateTimeEntry');
+
+$r = $redminer->_dispatch_name('deleteTimeEntry', 1);
+is_deeply($r, {
+	method => 'DELETE',
+	path   => 'time_entries/1',
+	content => undef,
+	query   => undef,
+}, 'deleteTimeEntry');
+
+#
+# Dispatching methods with more than 1 identifying object *and* compound object names:
+#
+
+$r = $redminer->_dispatch_name('projectIssueCategories', 1, { limit => 10, offset => 9 });
+is_deeply($r, {
+	method => 'GET',
+	path   => 'projects/1/issue_categories',
+	content => undef,
+	query   => { limit => 10, offset => 9 },
+}, 'projectIssueCategories');
+
+$r = $redminer->_dispatch_name('createProjectIssueCategory', 1, { name => 'My Category', assign_to_id => 1 });
+is_deeply($r, {
+	method => 'POST',
+	path   => 'projects/1/issue_categories',
+	content => { issue_category => { name => 'My Category', assign_to_id => 1 } },
+	query   => undef,
+}, 'projectIssueCategories');
 
 exit;