File Coverage

lib/OAuthomatic/ServerDef.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package OAuthomatic::ServerDef;
2             # ABSTRACT: Predefined URLs for some services
3              
4 1     1   556 use strict;
  1         1  
  1         30  
5 1     1   4 use warnings;
  1         1  
  1         28  
6 1     1   4 use feature 'state';
  1         0  
  1         75  
7 1     1   172 use namespace::sweep;
  0            
  0            
8              
9              
10             use Exporter::Shiny qw/oauthomatic_predefined_list
11             oauthomatic_predefined_for_name/;
12              
13             use Try::Tiny;
14             use Scalar::Util qw/blessed reftype/;
15             use Module::Pluggable
16             require => 1, # Just warns, so let's keep it
17             search_path => ["OAuthomatic::ServerDef"],
18             sub_name => '_oauthomatic_predefined_list';
19              
20              
21             sub _calculate_predefined {
22             my %predefined;
23             foreach my $predef_module (_oauthomatic_predefined_list()) {
24             unless($predef_module =~ /^OAuthomatic::ServerDef::(.*)$/x) {
25             # This should never happen, but let's just ignore
26             warn "OAuthomatic predef: skipping incorrect module $predef_module\n";
27             next;
28             }
29             my $short_module_name = $1;
30              
31             my $predef;
32             unless($predef_module->can('server')) {
33             warn "OAuthomatic predef: bad plugin, module $predef_module does not contain server() function\n";
34             next;
35             }
36             try {
37             $predef = $predef_module->server();
38             } catch {
39             warn "OAuthomatic predef: bad plugin, function $predef_module" . "::server() failed: $_\n";
40             };
41             next unless $predef;
42             my $predef_type = blessed $predef;
43             unless( $predef_type eq 'OAuthomatic::Server' ) {
44             $predef_type ||= reftype \$predef;
45             warn "OAuthomatic predef: bad plugin, function $predef_module" . "::server() returned invalid value (expected object of type OAuthomatic::Server, got $predef_type)\n";
46             next;
47             }
48             my $site_name = $predef->site_name;
49             unless($site_name eq $short_module_name) {
50             warn "OAuthomatic predef: bad plugin, $predef_module provided object with bad site_name (got '$site_name', expected '$short_module_name' - matching module name)\n";
51             next;
52             }
53             $predefined{ $site_name } = $predef;
54             }
55             return \%predefined;
56             }
57              
58             sub _predefined {
59             state $predefined = _calculate_predefined();
60             return $predefined;
61             }
62              
63              
64             sub oauthomatic_predefined_list {
65             my $predefined = _predefined();
66             return values %$predefined;
67             }
68              
69              
70             sub oauthomatic_predefined_for_name {
71             my $name = shift;
72             my $predefined = _predefined();
73             if( exists $predefined->{$name} ) {
74             return $predefined->{$name};
75             }
76             return OAuthomatic::Error::Generic->throw(
77             ident => "No such predefined server: $name",
78             extra => "Currently known servers: "
79             . join(", ", sort keys %$predefined)
80             . "\n"
81             . "Maybe you should install OAuthomatic::ServerDef::$name?\n",
82             );
83             }
84              
85             1;
86              
87             __END__
88              
89             =pod
90              
91             =encoding UTF-8
92              
93             =head1 NAME
94              
95             OAuthomatic::ServerDef - Predefined URLs for some services
96              
97             =head1 VERSION
98              
99             version 0.0201
100              
101             =head1 DESCRIPTION
102              
103             Manages list of definitions of selected OAuth endpoints. This module
104             is mostly used internally, whenever someone writes:
105              
106             OAuthomatic->new(
107             server => 'SomeName',
108             );
109              
110             it is used to look up appropriate definition.
111              
112             Run script L<oauthomatic_predefined_servers> to list all currently
113             known endpoints.
114              
115             To add server to the list, define module named
116             C<OAuthomatic::ServerDef::ServerName>:
117              
118             package OAuthomatic::ServerDef::ServerName;
119             use strict;
120             use warnings;
121             use OAuthomatic::Server;
122              
123             sub server {
124             return OAuthomatic::Server->new(
125             site_name => 'ServerName', # Must match package name
126             oauth_temporary_url => 'https://...',
127             # ... And the rest
128             );
129             }
130             1;
131              
132             =head1 EXPORTS FUNCTIONS
133              
134             =head2 oauthomatic_predefined_list
135              
136             Returns list of all predefined servers (list of L<OAuthomatic::Server> objects).
137              
138             =head2 oauthomatic_predefined_for_name(ServerName)
139              
140             Returns predefined object for given name, or dies.
141              
142             =head1 AUTHOR
143              
144             Marcin Kasperski <Marcin.Kasperski@mekk.waw.pl>
145              
146             =head1 COPYRIGHT AND LICENSE
147              
148             This software is copyright (c) 2015 by Marcin Kasperski.
149              
150             This is free software; you can redistribute it and/or modify it under
151             the same terms as the Perl 5 programming language system itself.
152              
153             =cut