From f08870cc98c347226709966b0e8d8051d1d45777 Mon Sep 17 00:00:00 2001
From: Gerhard Gonter <ggonter@gmail.com>
Date: Tue, 1 Aug 2017 16:36:02 +0200
Subject: [PATCH] streamlining for DataCite DOI minting and registration
---
dcd.pl | 10 ++++++++++
lib/DataCite/API.pm | 22 ++++++++++++++--------
2 files changed, 24 insertions(+), 8 deletions(-)
diff --git a/dcd.pl b/dcd.pl
index 1c6fac7..66c17e3 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 2b78f26..6e65ae8 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);
}
--
GitLab