File Coverage

blib/lib/Mock/Data/Plugin/SQLTypes.pm
Criterion Covered Total %
statement 77 86 89.5
branch 48 68 70.5
condition 19 47 40.4
subroutine 30 32 93.7
pod 13 14 92.8
total 187 247 75.7


line stmt bran cond sub pod time code
1             package Mock::Data::Plugin::SQLTypes;
2 1     1   911 use Mock::Data::Plugin -exporter_setup => 1;
  1         2  
  1         6  
3 1     1   515 use Mock::Data::Plugin::Net qw( cidr macaddr ), 'ipv4', { -as => 'inet' };
  1         2  
  1         7  
4 1     1   567 use Mock::Data::Plugin::Number qw( integer decimal float sequence uuid byte );
  1         3  
  1         4  
5 1     1   643 use Mock::Data::Plugin::Text 'join' => { -as => 'text_join' }, 'words';
  1         2  
  1         6  
6             our %type_generators= map +($_ => 1), qw(
7             integer tinyint smallint bigint
8             sequence serial smallserial bigserial
9             numeric decimal
10             float float4 real float8 double double_precision
11             bit bool boolean
12             varchar char nvarchar
13             text tinytext mediumtext longtext ntext
14             blob tinyblob mediumblob longblob bytea
15             varbinary binary
16             date datetime datetime2 datetimeoffset timestamp
17             datetime_with_time_zone datetime_without_time_zone
18             json jsonb
19             uuid inet cidr macaddr
20             );
21             export(keys %type_generators);
22              
23             # ABSTRACT: Collection of generators that produce data matching a SQL column type
24             our $VERSION = '0.04'; # VERSION
25              
26              
27             sub apply_mockdata_plugin {
28 1     1 0 5 my ($class, $mock)= @_;
29 1         6 $mock->load_plugin('Text')->add_generators(
30             map +("SQL::$_" => $class->can($_)), keys %type_generators
31             );
32             }
33              
34              
35             sub generator_for_type {
36 0     0 1 0 my ($mock, $type)= @_;
37 0         0 $type =~ s/\s+/_/g;
38             my $gen= $mock->generators->{$type} // $mock->generators->{"SQL::$type"}
39 0   0     0 // $type_generators{$type} && Mock::Data::GeneratorSub->new(__PACKAGE__->can($type));
      0        
      0        
40             # TODO: check for complex things like postgres arrays
41 0         0 return $gen;
42             }
43              
44              
45             sub tinyint {
46 10     10 1 18 my $mock= shift;
47 10 100       32 my $params= ref $_[0] eq 'HASH'? shift : undef;
48 10 100       59 integer($mock, { $params? %$params : (), bits => 8 }, @_);
49             }
50              
51             sub smallint {
52 10     10 1 16 my $mock= shift;
53 10 100       38 my $params= ref $_[0] eq 'HASH'? shift : undef;
54 10 100       63 integer($mock, { $params? %$params : (), bits => 16 }, @_);
55             }
56              
57             sub bigint {
58 10     10 1 14 my $mock= shift;
59 10 100       27 my $params= ref $_[0] eq 'HASH'? shift : undef;
60 10 100       50 integer($mock, { $params? %$params : (), bits => 64 }, @_);
61             }
62              
63              
64 1     1   580 BEGIN { *bigserial= *smallserial= *serial= *sequence; }
65              
66              
67 1     1   14 BEGIN { *numeric= *decimal; }
68              
69              
70 1     1   60 BEGIN { *real= *float4= *float; }
71              
72             sub double {
73 15     15 1 17 my $mock= shift;
74 15 50       32 my $params= ref $_[0] eq 'HASH'? shift : undef;
75 15 50       48 float($mock, { bits => 53, $params? %$params : () }, @_);
76             }
77              
78 1     1   30 BEGIN { *float8= *double_precision= *double; }
79              
80              
81             sub bit {
82 15     15 1 50 int rand 2;
83             }
84 1     1   196 BEGIN { *bool= *boolean= *bit; }
85              
86              
87             sub varchar {
88 30     30 1 33 my $mock= shift;
89 30 100       51 my $params= ref $_[0] eq 'HASH'? shift : undef;
90 30 100 100     82 my $size= shift // ($params? $params->{size} : undef) // 16;
      100        
91 30 100 50     101 my $size_weight= ($params? $params->{size_weight} : undef) // \&_default_size_weight;
92 30 100       45 my $source= ($params? $params->{source} : undef);
93 30 50 33     53 if (defined $source && !ref $source) {
94             Carp::croak("No generator '$source' available")
95 0 0       0 unless $mock->generators->{$source};
96             } else {
97 30 50       61 $source= $mock->generators->{word}? 'word' : \&word;
98             }
99 30         49 return text_join($mock, {
100             source => $source,
101             max_len => $size,
102             len => $size_weight->($size),
103             });
104             }
105             sub _default_size_weight {
106 30     30   33 my $size= shift;
107 30 50       175 $size <= 32? int rand($size+1)
    100          
108             : int rand(100)? int rand(33)
109             : 33+int rand($size-31)
110             }
111              
112              
113              
114 1     1   76 BEGIN { *nvarchar= *varchar; }
115              
116             sub text {
117 5     5 1 7 my $mock= shift;
118 5 50       11 my $params= ref $_[0] eq 'HASH'? shift : undef;
119 5 50       15 varchar($mock, { size => 256, ($params? %$params : ()) }, @_);
120             }
121              
122 1     1   404 BEGIN { *ntext= *tinytext= *mediumtext= *longtext= *text; }
123              
124              
125             sub char {
126 10     10 1 12 my $mock= shift;
127 10 50       40 my $params= ref $_[0] eq 'HASH'? shift : undef;
128 10 50 50     32 my $size= @_? shift : ($params? $params->{size} : undef) // 1;
    100          
129 10 50       23 my $str= varchar($mock, ($params? $params : ()), $size);
130 10 100       29 $str .= ' 'x($size - length $str) if length $str < $size;
131 10         31 return $str;
132             }
133              
134              
135             sub _epoch_to_iso8601 {
136 20     20   382 my @t= localtime(shift);
137 20         286 return sprintf "%04d-%02d-%02d %02d:%02d:%02d", $t[5]+1900, $t[4]+1, @t[3,2,1,0];
138             }
139             sub _iso8601_to_epoch {
140 20     20   37 my $str= shift;
141 20 50       154 $str =~ /^
142             (\d{4}) - (\d{2}) - (\d{2})
143             (?: [T ] (\d{2}) : (\d{2}) # maybe time
144             (?: :(\d{2}) # maybe seconds
145             (?: \. \d+ )? # ignore milliseconds
146             )?
147             (?: Z | [-+ ][:\d]+ )? # ignore timezone or Z
148             )?
149             /x or Carp::croak("Invalid date '$str'. Expecting format YYYY-MM-DD[ HH:MM:SS[.SSS][TZ]]");
150 20         934 require POSIX;
151 20   50     9731 return POSIX::mktime($6||0, $5||0, $4||0, $3, $2-1, $1-1900);
      50        
      50        
152             }
153              
154             sub datetime {
155 20     20 1 39 my $mock= shift;
156 20 100       66 my $params= ref $_[0] eq 'HASH'? shift : undef;
157 20 100 66     103 my $before= $params && $params->{before}? _iso8601_to_epoch($params->{before}) : (time - 86400);
158 20 100 66     95 my $after= $params && $params->{after}? _iso8601_to_epoch($params->{after}) : (time - int(10*365.25*86400));
159 20         89 _epoch_to_iso8601($after + int rand($before-$after));
160             }
161              
162             sub date {
163 10     10 1 27 substr(datetime(@_), 0, 10)
164             }
165              
166             BEGIN {
167 1     1   4 *timestamp= *datetime2= *datetime_without_time_zone= *datetime;
168 1         73 *datetimeoffset= *datetime_with_time_zone= *datetime;
169             }
170              
171              
172             sub blob {
173 10     10 1 22 my $mock= shift;
174 10 50       35 my $params= ref $_[0] eq 'HASH'? shift : undef;
175 10 50 66     51 my $size= shift // ($params? $params->{size} : undef) // 256;
      50        
176 10         41 byte($mock, $size);
177             }
178              
179 1     1   170 BEGIN { *tinyblob= *mediumblob= *longblob= *bytea= *binary= *varbinary= *blob; }
180              
181              
182             our $json;
183             sub _json_encoder {
184 0   0 0   0 $json //= do {
185 0         0 local $@;
186             my $mod= eval { require JSON::MaybeXS; 'JSON::MaybeXS' }
187             || eval { require JSON; 'JSON' }
188 0 0 0     0 || eval { require JSON::PP; 'JSON::PP' }
189             or Carp::croak("No JSON module found. This must be installed for the SQL::json generator.");
190 0         0 $mod->new->canonical->ascii
191             };
192             }
193              
194             sub json {
195 10     10 1 22 my $mock= shift;
196 10 50       33 my $params= ref $_[0] eq 'HASH'? shift : undef;
197 10 50 33     54 my $data= shift // ($params? $params->{data} : undef);
198 10 50       55 return defined $data? _json_encoder->encode($data) : '{}';
199             }
200              
201 1     1   34 BEGIN { *jsonb= *json; }
202              
203              
204             1;
205              
206             __END__