Skip to content
Browse files

First version

  • Loading branch information...
0 parents commit 026c04a22f3a5ed436f71c904ed86e0174819130 @kaare committed Feb 25, 2012
Showing with 292 additions and 0 deletions.
  1. +4 −0 Changes
  2. +35 −0 dist.ini
  3. +110 −0 lib/Role/REST/Client/Auth/Basic.pm
  4. +46 −0 t/boilerplate.t
  5. +59 −0 t/compile.t
  6. +4 −0 t/pod.t
  7. +34 −0 t/rest.t
4 Changes
@@ -0,0 +1,4 @@
+Revision history for Role-Model-REST-Auth-Basic
+
+{{$NEXT}}
+ - First version
35 dist.ini
@@ -0,0 +1,35 @@
+name = Role-REST-Client-Auth-Client
+author = Kaare Rasmussen <kaare at cpan dot net>
+license = Perl_5
+copyright_holder = Kaare Rasmussen
+
+[Git::NextVersion]
+version_regexp = ^release-(.+)$
+
+[@Basic]
+[ModuleBuild]
+[NextRelease]
+format = %-7v %{yyyy-MM-dd HH:mm:ss VVVV}d
+[InstallGuide]
+[MetaJSON]
+
+[MetaResources]
+repository.url = git://github.com/kaare/Role-REST-Client-Auth-Client.git
+repository.web = http://github.com/kaare/Role-REST-Client-Auth-Client
+repository.type = git
+
+[PodWeaver]
+;[NoTabsTests]
+;[EOLTests]
+;[Signature]
+[CheckChangeLog]
+[AutoPrereqs]
+[Prereqs / TestRequires]
+Test::More = 0.88
+Role::REST::Client = 0.02
+[PkgVersion]
+
+[Git::Tag]
+tag_format = release-%v
+
+[@Git]
110 lib/Role/REST/Client/Auth/Basic.pm
@@ -0,0 +1,110 @@
+package Role::REST::Client::Auth::Basic;
+
+use 5.010;
+use Moose::Role;
+use MIME::Base64;
+
+requires '_call', '_headers';
+
+has 'user' => (
+ isa => 'Str',
+ is => 'rw',
+ predicate => 'has_user',
+ trigger => sub {
+ my ($self, $user) = @_;
+ Carp::croak("Basic authentication user name can't contain ':'") if $user =~ /:/;
+ },
+);
+has 'passwd' => (
+ isa => 'Str',
+ is => 'rw',
+ predicate => 'has_passwd',
+);
+
+before '_call' => sub {
+ my ($self, $method, $endpoint, $data, $args) = @_;
+ return if $args->{authentication} and $args->{authentication} ne 'basic';
+
+ if ($self->has_user) {
+ my $user = $self->user;
+ my $passwd = $self->has_passwd ? $self->passwd : '';
+ $self->set_header('Basic ' . MIME::Base64::encode("$user:$passwd", ''));
+ }
+ return;
+};
+
+1;
+
+__END__
+
+# ABSTRACT: Basic Authentication for REST Client Role
+
+=pod
+
+=head1 NAME
+
+Role::REST::Client::Auth::Basic - Basic Authentication for REST Client Role
+
+=head1 SYNOPSIS
+
+ {
+ package RESTExample;
+
+ use Moose;
+ with 'Role::REST::Client', 'Role::REST::Client::Auth::Basic';
+
+ sub bar {
+ my ($self) = @_;
+ my $res = $self->post('foo/bar/baz', {foo => 'bar'});
+ my $code = $res->code;
+ my $data = $res->data;
+ return $data if $code == 200;
+ }
+
+ }
+
+ my $foo = RESTExample->new(
+ server => 'http://localhost:3000',
+ type => 'application/json',
+ user => 'mee',
+ passwd => 'sekrit',
+ );
+
+ $foo->bar;
+
+ # controller
+ sub foo : Local {
+ my ($self, $c) = @_;
+ # Call w/ basic authentication
+ my $res = $c->model('MyData')->post('foo/bar/baz', {foo => 'bar'});
+ my $code = $res->code;
+ my $data = $res->data;
+ ...
+ # Call w/o basic authentication
+ my $res = $c->model('MyData')->post('xyzzy', {foo => 'bar'}, {authentication => undef});
+ }
+
+=head1 DESCRIPTION
+
+This role adds basic authentication to Role::REST::Client.
+
+Just add it to your class and all calls will automatically authenticate.
+
+Add an authentication parameter to the arguments if you for some reaon don't want to authenticate
+
+=head1 AUTHOR
+
+Kaare Rasmussen, <kaare at cpan dot com>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to bug-role-rest-client-auth-basic at rt.cpan.org, or through the
+web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Role-REST-Client-Auth-Basic.
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2012 Kaare Rasmussen, all rights reserved.
+
+This library is free software; you can redistribute it and/or modify it under the same terms as
+Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may
+have available.
46 t/boilerplate.t
@@ -0,0 +1,46 @@
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+sub not_in_file_ok {
+ my ($filename, %regex) = @_;
+ open my $fh, "<", $filename
+ or die "couldn't open $filename for reading: $!";
+
+ my %violated;
+
+ while (my $line = <$fh>) {
+ while (my ($desc, $regex) = each %regex) {
+ if ($line =~ $regex) {
+ push @{$violated{$desc}||=[]}, $.;
+ }
+ }
+ }
+
+ if (%violated) {
+ fail("$filename contains boilerplate text");
+ diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
+ } else {
+ pass("$filename contains no boilerplate text");
+ }
+}
+
+not_in_file_ok(README =>
+ "The README is used..." => qr/The README is used/,
+ "'version information here'" => qr/to provide version information/,
+);
+
+not_in_file_ok(Changes =>
+ "placeholder date/time" => qr(Date/time)
+);
+
+sub module_boilerplate_ok {
+ my ($module) = @_;
+ not_in_file_ok($module =>
+ 'the great new $MODULENAME' => qr/ - The great new /,
+ 'boilerplate description' => qr/Quick summary of what the module/,
+ 'stub function definition' => qr/function[12]/,
+ );
+}
+
+module_boilerplate_ok('lib/Role/REST/Client/Auth/Basic.pm');
59 t/compile.t
@@ -0,0 +1,59 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+
+
+use File::Find;
+use File::Temp qw{ tempdir };
+
+my @modules;
+find(
+ sub {
+ return if $File::Find::name !~ /\.pm\z/;
+ my $found = $File::Find::name;
+ $found =~ s{^lib/}{};
+ $found =~ s{[/\\]}{::}g;
+ $found =~ s/\.pm$//;
+ # nothing to skip
+ push @modules, $found;
+ },
+ 'lib',
+);
+
+my @scripts;
+if ( -d 'bin' ) {
+ find(
+ sub {
+ return unless -f;
+ my $found = $File::Find::name;
+ # nothing to skip
+ push @scripts, $found;
+ },
+ 'bin',
+ );
+}
+
+my $plan = scalar(@modules) + scalar(@scripts);
+$plan ? (plan tests => $plan) : (plan skip_all => "no tests to run");
+
+{
+ # fake home for cpan-testers
+ # no fake requested ## local $ENV{HOME} = tempdir( CLEANUP => 1 );
+
+ like( qx{ $^X -Ilib -e "require $_; print '$_ ok'" }, qr/^\s*$_ ok/s, "$_ loaded ok" )
+ for sort @modules;
+
+ SKIP: {
+ eval "use Test::Script 1.05; 1;";
+ skip "Test::Script needed to test script compilation", scalar(@scripts) if $@;
+ foreach my $file ( @scripts ) {
+ my $script = $file;
+ $script =~ s!.*/!!;
+ script_compiles( $file, "$script script compiles" );
+ }
+ }
+}
4 t/pod.t
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();
34 t/rest.t
@@ -0,0 +1,34 @@
+use Test::More tests => 12;
+
+{
+ package RESTExample;
+
+ use Moose;
+ with 'Role::REST::Client';
+ with 'Role::REST::Client::Auth::Basic';
+
+ sub bar {
+ my ($self) = @_;
+ my $res = $self->post('foo/bar/baz', {foo => 'bar'});
+ my $code = $res->code;
+ my $data = $res->data;
+ return $data if $code == 200;
+ }
+}
+
+my %testdata = (
+ server => 'http://localhost:3000',
+ type => 'application/json',
+ user => 'mee',
+ passwd => 'sekrit',
+);
+ok(my $obj = RESTExample->new(%testdata), 'New object');
+isa_ok($obj, 'RESTExample');
+
+for my $item (qw/post get put delete _call _headers/) {
+ ok($obj->can($item), "Role method $item exists");
+}
+
+for my $item (qw/server type user passwd/) {
+ is($obj->$item, $testdata{$item}, "Role attribute $item is set");
+}

0 comments on commit 026c04a

Please sign in to comment.
Something went wrong with that request. Please try again.