Commits

Toby Inkster committed 6186e31

UNIVERSAL::AUTHORITY 0.001

Comments (0)

Files changed (12)

+use inc::Module::Package 'RDF:standard';
+

lib/UNIVERSAL/AUTHORITY.pm

+package UNIVERSAL::AUTHORITY;
+
+use 5.005;
+use strict;
+
+BEGIN {
+	$UNIVERSAL::AUTHORITY::AUTHORITY = 'cpan:TOBYINK';
+	$UNIVERSAL::AUTHORITY::VERSION   = '0.001';
+}
+
+use Carp qw[croak];
+use Scalar::Util qw[blessed];
+use UNIVERSAL qw[];
+
+sub UNIVERSAL::AUTHORITY
+{
+	my ($invocant, $test) = @_;	
+	my $authority = do {
+		no strict 'refs';
+		${"$invocant\::AUTHORITY"};
+		};
+	
+	if (scalar @_ > 1)
+	{
+		if (defined $authority)
+		{
+			croak("Invocant ($invocant) has authority '$authority'.")
+				unless _reasonably_smart_match($authority, $test);
+		}
+		else
+		{
+			croak("Invocant ($invocant) has no authority defined.")
+				unless _reasonably_smart_match($authority, $test);
+		}
+	}
+	
+	return $authority;
+}
+
+sub _reasonably_smart_match
+{
+	my ($a, $b) = @_;
+	
+	if (!defined $b)
+	{
+		return !defined $a;
+	}
+	elsif (ref $b eq 'CODE')
+	{
+		return $b->($a);
+	}
+	elsif (ref $b eq 'HASH')
+	{
+		return unless defined $a;
+		return exists $b->{$a};
+	}
+	elsif (ref $b eq 'ARRAY')
+	{
+		return grep { _reasonably_smart_match($a, $_) } @$b;
+	}
+	elsif (ref $b eq 'Regexp')
+	{
+		return ($a =~ $b);
+	}
+	else
+	{
+		return ($a eq $b);
+	}
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+UNIVERSAL::AUTHORITY - adds an AUTHORITY method to UNIVERSAL
+
+=head1 SYNOPSIS
+
+ if (HTML::HTML5::Writer->AUTHORITY ne HTML::HTML5::Builder->AUTHORITY)
+ {
+   warn "Closely intertwined modules with different authors!\n";
+   warn "There may be trouble ahead...";
+ }
+
+ # Only trust STEVAN's releases
+ Moose->AUTHORITY('cpan:STEVAN'); # dies if doesn't match
+
+=head1 DESCRIPTION
+
+This module adds an C<AUTHORITY> function to the C<UNIVERSAL> package, which
+works along the same lines as the C<VERSION> function. Because it is defined
+in C<UNIVERSAL>, it becomes instantly available as a method for any blessed
+objects, and as a class method for any package.
+
+The authority of a package can be defined like this:
+
+ package MyApp;
+ BEGIN { $MyApp::AUTHORITY = 'cpan:JOEBLOGGS'; }
+
+The authority should be a URI identifying the person, team, organisation
+or trained chimp responsible for the release of the package. The
+pseudo-URI scheme C<< cpan: >> is the most commonly used identifier.
+
+=head2 C<< UNIVERSAL::AUTHORITY >>
+
+Called with no parameters returns the authority of a CPAN release.
+
+=head2 C<< UNIVERSAL::AUTHORITY($test) >>
+
+If passed a test, will croak if the test fails. The authority is tested
+against the test using something approximating Perl 5.10's smart match
+operator. (Briefly, you can pass a string for C<eq> comparison, a regular
+expression, a code reference to use as a callback, or an array reference
+that will be grepped.)
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=UNIVERSAL-AUTHORITY>.
+
+=head1 SEE ALSO
+
+L<UNIVERSAL>,
+L<UNIVERSAL::which>,
+L<UNIVERSAL::dump>,
+L<UNIVERSAL::DOES>,
+&c.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2011 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=head1 DISCLAIMER OF WARRANTIES
+
+THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+
+# This file acts as the project's changelog.
+
+@prefix :        <http://usefulinc.com/ns/doap#> .
+@prefix dcs:     <http://ontologi.es/doap-changeset#> .
+@prefix dc:      <http://purl.org/dc/terms/> .
+@prefix dist:    <http://purl.org/NET/cpan-uri/dist/UNIVERSAL-AUTHORITY/> .
+@prefix rdfs:    <http://www.w3.org/2000/01/rdf-schema#> .
+@prefix xsd:     <http://www.w3.org/2001/XMLSchema#> .
+
+dist:project :release dist:v_0-001 .
+dist:v_0-001
+	a               :Version ;
+	dc:issued       "2011-11-05"^^xsd:date ;
+	:revision       "0.001"^^xsd:string ;
+	:file-release   <http://backpan.cpan.org/authors/id/T/TO/TOBYINK/UNIVERSAL-AUTHORITY-0.001.tar.gz> ;
+	rdfs:label      "'Twas his intent" .
+
+# This file contains general metadata about the project.
+
+@prefix :        <http://usefulinc.com/ns/doap#> .
+@prefix dc:      <http://purl.org/dc/terms/> .
+@prefix foaf:    <http://xmlns.com/foaf/0.1/> .
+@prefix rdfs:    <http://www.w3.org/2000/01/rdf-schema#> .
+@prefix xsd:     <http://www.w3.org/2001/XMLSchema#> .
+
+<http://purl.org/NET/cpan-uri/dist/UNIVERSAL-AUTHORITY/project>
+	a               :Project ;
+	:programming-language "Perl" ;
+	:name           "UNIVERSAL-AUTHORITY" ;
+	:shortdesc      "adds an AUTHORITY method to UNIVERSAL" ;
+	:homepage       <https://metacpan.org/release/UNIVERSAL-AUTHORITY> ;
+	:download-page  <https://metacpan.org/release/UNIVERSAL-AUTHORITY> ;
+	:bug-database   <http://rt.cpan.org/Dist/Display.html?Queue=UNIVERSAL-AUTHORITY> ;
+	:created        "2011-11-05"^^xsd:date ;
+	:license        <http://dev.perl.org/licenses/> ;
+	:developer      [ a foaf:Person ; foaf:name "Toby Inkster" ; foaf:mbox <mailto:tobyink@cpan.org> ] .
+
+<http://dev.perl.org/licenses/>
+	dc:title        "the same terms as the perl 5 programming language system itself" .
+

meta/makefile.ttl

+# This file provides instructions for packaging.
+
+@prefix : <http://purl.org/NET/cpan-uri/terms#> .
+
+<http://purl.org/NET/cpan-uri/dist/UNIVERSAL-AUTHORITY/project>
+	:perl_version_from _:main ;
+	:version_from _:main ;
+	:readme_from _:main ;
+	:test_requires "Test::More 0.61" , "Test::Exception" ;
+	:requires "Scalar::Util" , "Carp", "UNIVERSAL" .
+
+_:main <http://www.semanticdesktop.org/ontologies/2007/03/22/nfo#fileName> "lib/UNIVERSAL/AUTHORITY.pm" .
+
+use Test::More tests => 2;
+BEGIN { use_ok('UNIVERSAL::AUTHORITY') };
+can_ok(UNIVERSAL => AUTHORITY);
+package Local::MyTest;
+
+our $AUTHORITY = 'http://example.net/';
+
+package main;
+
+use Test::More tests => 3;
+use UNIVERSAL::AUTHORITY;
+
+is(
+	Local::MyTest->AUTHORITY,
+	'http://example.net/',
+	'test package has correct authority',
+	);
+
+is(
+	'UNIVERSAL::AUTHORITY'->AUTHORITY,
+	'cpan:TOBYINK',
+	'UNIVERSAL::AUTHORITY has correct authority',
+	);
+
+SKIP: {
+	skip "need Moose 2.02", 1
+		unless eval 'use Moose 2.02; 1;';
+	skip "Moose seems to have stopped defining an authority", 1
+		unless defined $Moose::AUTHORITY;
+		
+	ok(
+		defined Moose->AUTHORITY,
+		'Moose has an authority',
+		);
+}
+package Local::MyTest;
+
+our $AUTHORITY = 'http://example.net/';
+
+package main;
+
+use Test::More tests => 7;
+use Test::Exception;
+use UNIVERSAL::AUTHORITY;
+
+dies_ok
+	{ Local::MyTest->AUTHORITY('cpan:TOBYINK') }
+	'dies passed string';
+
+dies_ok
+	{ Local::MyTest->AUTHORITY(qr/^cpan:/i) }
+	'dies passed regexp';
+
+dies_ok
+	{ Local::MyTest->AUTHORITY(undef) }
+	'dies passed undef';
+	
+dies_ok
+	{ Local::MyTest->AUTHORITY(['mailto:joe@example.net' , qr/^cpan:/i]) }
+	'dies passed arrayref';
+
+lives_ok
+	{ Local::MyTest->AUTHORITY('http://example.net/') }
+	'lives passed string';
+
+lives_ok
+	{ Local::MyTest->AUTHORITY(qr/^http:/i) }
+	'lives passed regexp';
+
+lives_ok
+	{ Local::MyTest->AUTHORITY(['mailto:joe@example.net' , qr/^cpan:/i, 'http://example.net/']) }
+	'lives passed arrayref';
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
+

xt/02pod_coverage.t

+use Test::More;
+use Test::Pod::Coverage;
+
+my @modules = qw(UNIVERSAL::AUTHORITY);
+pod_coverage_ok($_, "$_ is covered")
+	foreach @modules;
+done_testing(scalar @modules);
+

xt/03meta_uptodate.t

+use Test::More tests => 1;
+use Test::RDF::DOAP::Version;
+doap_version_ok('UNIVERSAL-AUTHORITY', 'UNIVERSAL::AUTHORITY');
+
+use Test::EOL;
+all_perl_files_ok();