Browse files

Util.pm: add time conversion functions

  • Loading branch information...
1 parent 0035644 commit 44daf3bc0c7f2a180d598393bae19f27951c349b @marschap committed Jan 14, 2013
Showing with 162 additions and 0 deletions.
  1. +4 −0 Makefile.PL
  2. +6 −0 lib/Net/LDAP/FAQ.pod
  3. +152 −0 lib/Net/LDAP/Util.pm
View
4 Makefile.PL
@@ -52,6 +52,10 @@ features
-default => 0,
'URI::ldap' => 1.10,
],
+ 'Time conversion functions' => [
+ -default => 0,
+ 'Time::Local' => 0,
+ ],
'Read/Write DSML files' => [
-default => 0,
'MIME::Base64' => 0, # core module since Perl 5.7.3
View
6 lib/Net/LDAP/FAQ.pod
@@ -589,6 +589,12 @@ LWP::Protocol::ldap, LWP::Protocol::ldaps, or LWP::Protocol::ldapi modules.
If you need it, you can optain the latest releases from
http://search.cpan.org/search?module=JSON
+=item Time::Local
+
+This module is optional, and only required if you want to convert
+between UNIX time and generalizedTime using the functions provided
+in Net::LDAP::Util.
+
=item XML::SAX and XML::SAX::Writer
If you want to parse or write DSMLv1 documents with Net::LDAP::DSML
View
152 lib/Net/LDAP/Util.pm
@@ -45,6 +45,8 @@ our @EXPORT_OK = qw(
escape_dn_value
unescape_dn_value
ldap_url_parse
+ generalizedTime_to_time
+ time_to_generalizedTime
);
our %EXPORT_TAGS = (
error => [ qw(ldap_error_name ldap_error_text ldap_error_desc) ],
@@ -54,6 +56,7 @@ our %EXPORT_TAGS = (
escape => [ qw(escape_filter_value unescape_filter_value
escape_dn_value unescape_dn_value) ],
url => [ qw(ldap_url_parse) ],
+ time => [ qw(generalizedTime_to_time time_to_generalizedTime) ],
);
our $VERSION = '0.15';
@@ -721,6 +724,155 @@ my %opt = @_;
return wantarray ? %elements : \%elements;
}
+
+=item generalizedTime_to_time ( GENERALIZEDTIME )
+
+Convert the generalizedTime string B<GENERALIZEDTIME>, which is expected
+to match the template C<YYYYmmddHH[MM[SS]][(./,)d...](Z|(+/-)HH[MM])>
+to a floating point number compatible with UNIX time
+(i.e. the integral part of the number is a UNIX time).
+
+Returns an extended UNIX time or C<undef> on error.
+
+Times in years smaller than 1000 will lead to C<undef> being returned.
+This restriction is a direct effect of the year value interpretation rules
+in Time::Local.
+
+B<Note:> this function depends on Perl's implementation of time and Time::Local.
+See L<Time::Local/Limits of time_t>, L<Time::Local/Negative Epoch Values>, and
+L<perlport/gmtime> for restrictions in older versions of Perl.
+
+=cut
+
+sub generalizedTime_to_time($)
+{
+my $generalizedTime = shift;
+
+ if ($generalizedTime =~ /^\s*(\d{4})(\d{2})(\d{2})
+ (\d{2})(?:(\d{2})(\d{2})?)?
+ (?:[.,](\d+))?\s*(Z|[+-]\d{2}(?:\d{2})?)\s*$/x) {
+ my ($year,$month,$day,$hour,$min,$sec,$dec,$offset) = ($1,$2,$3,$4,$5,$6,$7,$8);
+
+ # Time::Local's timegm() interpret years strangely
+ if ($year >= 1000) {
+ $dec = "0.$dec";
+
+ # decimals in case of missing minutes / seconds - see RFC 4517
+ if (!defined($min)) {
+ $min = 0;
+
+ if ($dec) {
+ $min = int(60 * $dec);
+ $dec = sprintf('%.4f', 60 * $dec - $min);
+ }
+ }
+ if (!defined($sec)) {
+ $sec = 0;
+
+ if ($dec) {
+ $sec = int(60 * $dec);
+ $dec = sprintf('%.2f', 60 * $dec - $sec);
+ }
+ }
+
+ eval { require Time::Local; };
+ unless ($@) {
+ my $time;
+
+ eval { $time = Time::Local::timegm($sec,$min,$hour,$day,$month-1,$year); };
+ unless ($@) {
+ if ($offset =~ /^([+-])(\d{2})(\d{2})?$/) {
+ my ($direction,$hourdelta,$mindelta) = ($1,$2,$3);
+
+ $mindelta = 0 if (!$mindelta);
+ $time += ($direction eq '-')
+ ? 3600 * $hourdelta + 60 * $mindelta
+ : -3600 * $hourdelta - 60 * $mindelta;
+ }
+
+ # make decimal part directional
+ if ($dec != 0) {
+ if ($time < 0) {
+ $dec = 1 - $dec;
+ $time++;
+ }
+ $dec =~ s/^0\.//;
+ $time .= ".$dec";
+ }
+
+ return $time;
+ }
+ }
+ }
+ }
+
+ return undef;
+}
+
+
+=item time_to_generalizedTime ( TIME [, OPTIONS ] )
+
+Convert the UNIX time B<TIME> to a generalizedTime string.
+
+In extension to UNIX times, B<TIME> may be a floating point number,
+the decimal part will be used for the resulting generalizedTime.
+
+B<OPTIONS> is a list of key/value pairs. The following keys are recognized:
+
+=over 4
+
+=item AD
+
+Take care of an ActiveDirectory peculiarity to always require decimals.
+
+=back
+
+Returns the generalizedTime string, or C<undef> on error.
+
+Times before BC or after year 9999 result in C<undef>
+as they cannot be represented in the generalizedTime format.
+
+B<Note:> this function depends on Perl's implementation of gmtime.
+See L<Time::Local/Limits of time_t>, L<Time::Local/Negative Epoch Values>, and
+L<perlport/gmtime> for restrictions in older versions of Perl.
+
+=cut
+
+sub time_to_generalizedTime($;@)
+{
+my $arg = shift;
+my %opt = @_;
+
+ if ($arg =~ /^(\-?\d*)(?:[.,](\d*))?$/) {
+ my ($time, $dec) = ($1, $2);
+
+ $dec = defined($dec) ? "0.$dec" : 0;
+
+ # decimal part of time is directional: make sure to have it positive
+ if ($time < 0 && $dec != 0) {
+ $time--;
+ $dec = 1 - $dec;
+ }
+
+ $time = int($time);
+
+ my ($sec,$min,$hour,$mday,$month,$year,$wday,$yday,$isdst) = gmtime(int($time));
+
+ # generalizedTime requires 4-digit year without sign
+ return undef if ($year < -1900 || $year > 8099);
+
+ $dec =~ s/^0?\.(\d*?)0*$/$1/;
+
+ return sprintf("%04d%02d%02d%02d%02d%02d%sZ",
+ $year+1900, $month+1, $mday, $hour, $min, $sec,
+ # AD peculiarity: if there are no decimals, add .0 as decimals
+ ($dec ? ('.'.$dec) : ($opt{AD} ? '.0' : '')));
+ }
+
+ return undef;
+}
+
+
=back

0 comments on commit 44daf3b

Please sign in to comment.