File Coverage

blib/lib/Dist/Inkt/Role/ProcessDOAP.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package Dist::Inkt::Role::ProcessDOAP;
2              
3             our $AUTHORITY = 'cpan:TOBYINK';
4             our $VERSION = '0.021';
5              
6 1     1   1951 use Moose::Role;
  0            
  0            
7             use List::MoreUtils 'uniq';
8             use namespace::autoclean;
9              
10             with 'Dist::Inkt::Role::RDFModel';
11              
12             use RDF::Trine::Namespace qw[RDF RDFS OWL XSD];
13             my $CPAN = 'RDF::Trine::Namespace'->new('http://purl.org/NET/cpan-uri/terms#');
14             my $DC = 'RDF::Trine::Namespace'->new('http://purl.org/dc/terms/');
15             my $DOAP = 'RDF::Trine::Namespace'->new('http://usefulinc.com/ns/doap#');
16             my $DEPS = 'RDF::Trine::Namespace'->new('http://ontologi.es/doap-deps#');
17             my $FOAF = 'RDF::Trine::Namespace'->new('http://xmlns.com/foaf/0.1/');
18             my $NFO = 'RDF::Trine::Namespace'->new('http://www.semanticdesktop.org/ontologies/2007/03/22/nfo#');
19             my $SKOS = 'RDF::Trine::Namespace'->new('http://www.w3.org/2004/02/skos/core#');
20              
21             after PopulateMetadata => sub
22             {
23             my $self = shift;
24            
25             $self->log('Processing the DOAP vocabulary');
26            
27             my $meta = $self->metadata;
28            
29             delete $meta->{abstract} if $meta->{abstract} eq 'unknown';
30             $meta->{abstract} ||= $_
31             for grep defined, $self->doap_project->shortdesc;
32            
33             $meta->{description} ||= $_
34             for grep defined, $self->doap_project->description;
35            
36             push @{ $meta->{license} }, $self->cpanmeta_license_code;
37            
38             my $r = $self->cpanmeta_resources;
39             $meta->{resources}{$_} ||= $r->{$_} for keys %$r;
40            
41             push @{ $meta->{keywords} }, $self->cpanmeta_keywords;
42            
43             for my $role ($self->model->objects(RDF::Trine::iri($self->project_uri), $CPAN->x_help_wanted))
44             {
45             next unless $role->uri =~ /(\w+)\z/;
46             push @{ $meta->{x_help_wanted} ||= [] }, $1;
47             }
48             };
49              
50             sub cpanmeta_license_code
51             {
52             my $self = shift;
53              
54             my @r;
55             for (@{ $self->doap_project->license })
56             {
57             my $license_code = {
58             'http://www.gnu.org/licenses/agpl-3.0.txt' => 'agpl_3',
59             'http://www.apache.org/licenses/LICENSE-1.1' => 'apache_1_1',
60             'http://www.apache.org/licenses/LICENSE-2.0' => 'apache_2_0',
61             'http://www.apache.org/licenses/LICENSE-2.0.txt' => 'apache_2_0',
62             'http://www.perlfoundation.org/artistic_license_1_0' => 'artistic_1',
63             'http://opensource.org/licenses/artistic-license.php' => 'artistic_1',
64             'http://www.perlfoundation.org/artistic_license_2_0' => 'artistic_2',
65             'http://opensource.org/licenses/artistic-license-2.0.php' => 'artistic_2',
66             'http://www.opensource.org/licenses/bsd-license.php' => 'bsd',
67             'http://creativecommons.org/publicdomain/zero/1.0/' => 'unrestricted',
68             'http://www.freebsd.org/copyright/freebsd-license.html' => 'freebsd',
69             'http://www.gnu.org/licenses/old-licenses/fdl-1.2.html' => 'gfdl_1_2',
70             'http://www.gnu.org/copyleft/fdl.html' => 'gfdl_1_3',
71             'http://www.opensource.org/licenses/gpl-license.php' => 'gpl_1',
72             'http://www.gnu.org/licenses/old-licenses/gpl-1.0.txt' => 'gpl_1',
73             'http://www.opensource.org/licenses/gpl-2.0.php' => 'gpl_2',
74             'http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt' => 'gpl_2',
75             'http://www.opensource.org/licenses/gpl-3.0.html' => 'gpl_3',
76             'http://www.gnu.org/licenses/gpl-3.0.txt' => 'gpl_3',
77             'http://www.opensource.org/licenses/lgpl-license.php' => 'open_source',
78             'http://www.opensource.org/licenses/lgpl-2.1.php' => 'lgpl_2_1',
79             'http://www.gnu.org/licenses/old-licenses/lgpl-2.1.txt' => 'lgpl_2_1',
80             'http://www.opensource.org/licenses/lgpl-3.0.html' => 'lgpl_3_0',
81             'http://www.gnu.org/licenses/lgpl-3.0.txt' => 'lgpl_3_0',
82             'http://www.opensource.org/licenses/mit-license.php' => 'mit',
83             'http://www.mozilla.org/MPL/MPL-1.0.txt' => 'mozilla_1_0',
84             'http://www.mozilla.org/MPL/MPL-1.1.txt' => 'mozilla_1_1',
85             'http://opensource.org/licenses/mozilla1.1.php' => 'mozilla_1_1',
86             'http://www.openssl.org/source/license.html' => 'openssl',
87             'http://dev.perl.org/licenses/' => 'perl_5',
88             'http://www.opensource.org/licenses/postgresql' => 'open_source',
89             'http://trolltech.com/products/qt/licenses/licensing/qpl' => 'qpl_1_0',
90             'http://h71000.www7.hp.com/doc/83final/BA554_90007/apcs02.html' => 'ssleay',
91             'http://www.openoffice.org/licenses/sissl_license.html' => 'sun',
92             'http://www.zlib.net/zlib_license.html' => 'zlib',
93             }->{ $_->uri };
94              
95             push @r, $license_code if $license_code;
96             }
97            
98             @r ? uniq(@r) : ('unknown');
99             }
100              
101             sub cpanmeta_resources
102             {
103             my $self = shift;
104              
105             my %resources;
106            
107             $resources{license} = [ map $_->uri, @{ $self->doap_project->license } ];
108             $resources{homepage} ||= $_->uri for @{ $self->doap_project->homepage };
109            
110             my (@bug) = map $_->uri, $self->doap_project->bug_database;
111             for (@bug) {
112             if (/^mailto:(.+)/i) {
113             $resources{bugtracker}{mailto} ||= $1;
114             }
115             else {
116             $resources{bugtracker}{web} ||= $_;
117             }
118             }
119            
120             REPO: for my $repo (@{$self->doap_project->repository || []})
121             {
122             if ($repo->location || $repo->browse)
123             {
124             my $r = {};
125             $r->{url} = $repo->location->uri if $repo->location;
126             $r->{web} = $repo->browse->uri if $repo->browse;
127             for my $type (@{ $repo->rdf_type || [] })
128             {
129             $r->{type} ||= lc($1) if $type->uri =~ m{[/#](\w+)Repository$};
130             }
131             if ($r->{web} =~ m{^https?://github.com/([^/]+)/([^/]+)$})
132             {
133             $r->{url} ||= sprintf('git://github.com/%s/%s.git', $1, $2);
134             $r->{type} ||= 'git';
135             }
136             $resources{repository} = $r;
137             last REPO;
138             }
139             }
140            
141             ($resources{x_mailinglist}) =
142             map { $_->uri }
143             grep defined,
144             $self->doap_project->mailing_list;
145            
146             ($resources{x_wiki}) =
147             map { $_->uri }
148             grep defined,
149             $self->doap_project->wiki;
150            
151             ($resources{x_identifier}) =
152             map { $_->uri }
153             grep defined,
154             $self->doap_project->rdf_about;
155            
156             ($resources{x_IRC}) =
157             map { $_->uri }
158             grep defined,
159             $self->model->objects(RDF::Trine::iri($self->project_uri), $CPAN->x_IRC);
160            
161             delete $resources{$_} for grep !defined $resources{$_}, keys %resources;
162            
163             return \%resources;
164             }
165              
166             sub cpanmeta_keywords
167             {
168             my $self = shift;
169             my $model = $self->model;
170            
171             my %keywords;
172             CATEGORY: for my $cat (@{ $self->doap_project->category || [] })
173             {
174             LABEL: for my $label ($model->objects_for_predicate_list($cat, $SKOS->prefLabel, $RDFS->label, $DOAP->name, $FOAF->name))
175             {
176             next LABEL unless $label->is_literal;
177             $keywords{ uc $label->literal_value } = $label->literal_value;
178             next CATEGORY;
179             }
180             }
181            
182             sort values %keywords;
183             }
184              
185             1;