File Coverage

blib/lib/Mastodon/Types.pm
Criterion Covered Total %
statement 33 33 100.0
branch n/a
condition n/a
subroutine 11 11 100.0
pod n/a
total 44 44 100.0


line stmt bran cond sub pod time code
1             package Mastodon::Types;
2              
3 7     7   190799 use strict;
  7         14  
  7         166  
4 7     7   29 use warnings;
  7         11  
  7         246  
5              
6             our $VERSION = '0.016';
7              
8 7     7   2479 use Type::Library -base;
  7         115102  
  7         58  
9              
10 7     7   4833 use Type::Utils -all;
  7         27793  
  7         70  
11 7     7   22075 use Types::Standard qw( Str HashRef Num );
  7         250289  
  7         83  
12 7     7   9003 use Types::Path::Tiny qw( File to_File);
  7         173106  
  7         60  
13              
14 7     7   6555 use URI;
  7         26963  
  7         197  
15 7     7   5111 use DateTime;
  7         2749939  
  7         299  
16 7     7   3428 use MIME::Base64;
  7         3979  
  7         464  
17 7     7   2679 use Class::Load qw( load_class );
  7         37928  
  7         4281  
18              
19             duck_type 'UserAgent', [qw( get post delete )];
20              
21             class_type 'URI', { class => 'URI' };
22              
23             coerce 'URI', from Str, via {
24             s{^/+}{}g;
25             my $uri = URI->new((m{^https?://} ? q{} : 'https://') . $_);
26             $uri->scheme('https') unless $uri->scheme;
27             return $uri;
28             };
29              
30             # We provide our own DateTime type because the Types::DateTime distribution
31             # is currently undermaintained
32              
33             class_type 'DateTime', { class => 'DateTime' };
34              
35             class_type 'HTTPResponse', { class => 'HTTP::Response' };
36              
37             coerce 'DateTime',
38             from Num,
39             via { 'DateTime'->from_epoch( epoch => $_ ) }
40             from Str,
41             via {
42             require DateTime::Format::Strptime;
43             DateTime::Format::Strptime->new(
44             pattern => '%FT%T.%3N%Z',
45             on_error => 'croak',
46             )->parse_datetime($_);
47             };
48              
49             # Validation here could be improved
50             # It is either a username if a local account, or a username@instance.tld
51             # but what characters are valid?
52             declare 'Acct', as Str;
53              
54             declare 'Image',
55             as Str, where { m{^data:image/(?:png|jpeg);base64,[a-zA-Z0-9/+=\n]+$} };
56              
57             coerce File, from Str, via {
58             require Path::Tiny;
59             return Path::Tiny::path( $_ );
60             };
61              
62             coerce 'Image',
63             from File->coercibles,
64             via {
65             my $file = to_File($_);
66             require Image::Info;
67             require MIME::Base64;
68             my $type = lc Image::Info::image_type( $file->stringify )->{file_type};
69             my $img = "data:image/$type;base64,"
70             . MIME::Base64::encode_base64( $file->slurp_raw );
71             return $img;
72             };
73              
74             # Entity types
75              
76             my @entities = qw(
77             Status Account Instance Attachment Card Context Mention
78             Notification Relationship Report Results Error Tag Application
79             );
80              
81             foreach my $name (@entities) {
82             class_type $name, { class => "Mastodon::Entity::$name" };
83             coerce $name, from HashRef, via {
84             load_class "Mastodon::Entity::$name";
85             "Mastodon::Entity::$name"->new($_);
86             };
87             }
88              
89             role_type 'Entity', { role => 'Mastodon::Role::Entity' };
90              
91             coerce 'Instance',
92             from Str,
93             via {
94             require Mastodon::Entity::Instance;
95             Mastodon::Entity::Instance->new({
96             uri => $_,
97             });
98             };
99              
100             coerce 'Entity',
101             from HashRef,
102             via {
103             my $hash = $_;
104             my $entity;
105              
106 7     7   51 use Try::Tiny;
  7         45  
  7         1006  
107             foreach my $name (@entities) {
108             $entity = try {
109             load_class "Mastodon::Entity::$name";
110             "Mastodon::Entity::$name"->new($hash);
111             };
112             last if defined $entity;
113             }
114              
115             return $entity;
116             };
117              
118             1;