File Coverage

blib/lib/Data/ID/Maildir.pm
Criterion Covered Total %
statement 24 24 100.0
branch 2 2 100.0
condition 1 3 33.3
subroutine 7 7 100.0
pod 1 1 100.0
total 35 37 94.5


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Data::ID::Maildir - generate maildir-style unique IDs
4              
5             =head1 SYNOPSIS
6              
7             use Data::ID::Maildir qw(maildir_id);
8              
9             $id = maildir_id;
10              
11             =head1 DESCRIPTION
12              
13             This module exports one function, C, which generates
14             maildir-style unique IDs.
15              
16             =cut
17              
18             package Data::ID::Maildir;
19              
20 1     1   52618 { use 5.006; }
  1         3  
21 1     1   5 use warnings;
  1         2  
  1         29  
22 1     1   4 use strict;
  1         7  
  1         25  
23              
24 1     1   272 use Sys::Hostname qw(hostname);
  1         1002  
  1         61  
25 1     1   307 use Time::HiRes 1.00 qw(gettimeofday);
  1         1320  
  1         7  
26              
27             our $VERSION = "0.005";
28              
29 1     1   568 use parent "Exporter";
  1         253  
  1         5  
30             our @EXPORT_OK = qw(maildir_id);
31              
32             =head1 FUNCTIONS
33              
34             =over
35              
36             =item maildir_id
37              
38             =item maildir_id(HOSTNAME)
39              
40             Generates a maildir-style unique ID. The ID is based on the time,
41             process ID, and hostname; it is guaranteed to be unique among IDs
42             generated by this algorithm provided the hostname is unique among hosts
43             using this algorithm. The hostname may be specified to the function if
44             it is necessary to override it.
45              
46             =cut
47              
48             sub maildir_id(;$) {
49 4     4 1 81 my($hostname) = @_;
50 4 100       14 $hostname = hostname unless defined $hostname;
51 4         28 my($sec, $usec) = gettimeofday;
52 4         5 my($new_sec, $new_usec);
53 4   33     7 do {
54 4         56 ($new_sec, $new_usec) = gettimeofday;
55             } while($new_sec == $sec && $new_usec == $usec);
56 4         29 $sec.".M".$usec."P".$$.".".$hostname;
57             }
58              
59             =back
60              
61             =head1 BUGS
62              
63             Can theoretically generate duplicate message IDs during a leap second.
64              
65             =head1 SEE ALSO
66              
67             L,
68             L,
69             L,
70             L
71              
72             =head1 AUTHOR
73              
74             Andrew Main (Zefram)
75              
76             =head1 COPYRIGHT
77              
78             Copyright (C) 2004, 2007, 2010, 2011, 2017
79             Andrew Main (Zefram)
80              
81             =head1 LICENSE
82              
83             This module is free software; you can redistribute it and/or modify it
84             under the same terms as Perl itself.
85              
86             =cut
87              
88             1;