diff --git a/dcd.pl b/dcd.pl index 1c6fac7bd073b213794ba0c3ee1f525a1abd3f9e..66c17e376ee8152db159962a5776e6cabbaacc78 100755 --- a/dcd.pl +++ b/dcd.pl @@ -240,3 +240,13 @@ __END__ Firstname Lastname <address@example.org> +=head1 BUGS + +wrong registry label is not dectected, e.g. when using + + "registry" : "DataCite_Test_prod", + +instead of + + "registry" : "DataCite_Test_Prod", + diff --git a/lib/DataCite/API.pm b/lib/DataCite/API.pm index 2b78f26b806c84a62eca91e2f7343048965b5097..6e65ae886763f9a76fd2f3646adf88888482839e 100644 --- a/lib/DataCite/API.pm +++ b/lib/DataCite/API.pm @@ -13,6 +13,7 @@ Interact with DataCitee API ([1], [2]) * [2] https://mds.test.datacite.org/static/apidoc * [3] http://schema.test.datacite.org/ * [4] https://blog.datacite.org/cool-dois/ +* [5] http://www.crockford.com/wrmg/base32.html =cut @@ -36,7 +37,7 @@ sub mint_doi # my $prefix= ($self->{mode} eq 'test') ? $cfg->{test_prefix} : $cfg->{prefix}; - return join ('/', $self->{config}->{prefix}, mk_doi()), + return join ('/', $self->{config}->{prefix}, mk_suffix()), } sub register_doi @@ -71,9 +72,9 @@ EOX sub datacite_request { - my $self= shift; - my $method= shift; - my $verb= shift; + my $self= shift; + my $method= shift; + my $verb= shift; my $content= shift; my $content_type= shift; @@ -103,15 +104,15 @@ sub datacite_request =head1 INTERNAL FUNCTIONS -=head2 $doi= mk_doi() +=head2 $doi= mk_suffix() actually mint a DOI according to [4] =cut -sub mk_doi +sub mk_suffix { - my $tries= 3; + my $tries= 10; my $str; do @@ -124,8 +125,13 @@ sub mk_doi return join ('-', $1, $2) if ($str =~ m#^([A-Z0-9]{4})([A-Z0-9]{4})$#); } while ($tries-- > 0); -# TODO: print some kind of warning? + # As a last resort, print the string which might + # contain *, =, ~, and $ . + # These strings are valid, but maybe less readable ... + + return join ('-', $1, $2) if ($str =~ m#^(.{4})(.{4})$#); +# TODO: this should not happen, print some kind of warning? return ($str); }