-
Notifications
You must be signed in to change notification settings - Fork 74
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge pull request #2604 from RotherOSS/issue-#2586-cpanfile
Issue #2586 cpanfile
- Loading branch information
Showing
12 changed files
with
1,263 additions
and
259 deletions.
There are no files selected for viewing
Large diffs are not rendered by default.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,101 @@ | ||
package Class::Accessor::Faster; | ||
use base 'Class::Accessor'; | ||
use strict; | ||
$Class::Accessor::Faster::VERSION = '0.34'; | ||
|
||
my %slot; | ||
sub _slot { | ||
my($class, $field) = @_; | ||
my $n = $slot{$class}->{$field}; | ||
return $n if defined $n; | ||
$n = keys %{$slot{$class}}; | ||
$slot{$class}->{$field} = $n; | ||
return $n; | ||
} | ||
|
||
sub new { | ||
my($proto, $fields) = @_; | ||
my($class) = ref $proto || $proto; | ||
my $self = bless [], $class; | ||
|
||
$fields = {} unless defined $fields; | ||
for my $k (keys %$fields) { | ||
my $n = $class->_slot($k); | ||
$self->[$n] = $fields->{$k}; | ||
} | ||
return $self; | ||
} | ||
|
||
sub make_accessor { | ||
my($class, $field) = @_; | ||
my $n = $class->_slot($field); | ||
return sub { | ||
return $_[0]->[$n] if scalar(@_) == 1; | ||
return $_[0]->[$n] = scalar(@_) == 2 ? $_[1] : [@_[1..$#_]]; | ||
}; | ||
} | ||
|
||
sub make_ro_accessor { | ||
my($class, $field) = @_; | ||
my $n = $class->_slot($field); | ||
return sub { | ||
return $_[0]->[$n] if @_ == 1; | ||
my $caller = caller; | ||
$_[0]->_croak("'$caller' cannot alter the value of '$field' on objects of class '$class'"); | ||
}; | ||
} | ||
|
||
sub make_wo_accessor { | ||
my($class, $field) = @_; | ||
my $n = $class->_slot($field); | ||
return sub { | ||
if (@_ == 1) { | ||
my $caller = caller; | ||
$_[0]->_croak("'$caller' cannot access the value of '$field' on objects of class '$class'"); | ||
} else { | ||
return $_[0]->[$n] = $_[1] if @_ == 2; | ||
return (shift)->[$n] = \@_; | ||
} | ||
}; | ||
} | ||
|
||
1; | ||
|
||
__END__ | ||
=head1 NAME | ||
Class::Accessor::Faster - Even faster, but less expandable, accessors | ||
=head1 SYNOPSIS | ||
package Foo; | ||
use base qw(Class::Accessor::Faster); | ||
=head1 DESCRIPTION | ||
This is a faster but less expandable version of Class::Accessor::Fast. | ||
Class::Accessor's generated accessors require two method calls to accompish | ||
their task (one for the accessor, another for get() or set()). | ||
Class::Accessor::Fast eliminates calling set()/get() and does the access itself, | ||
resulting in a somewhat faster accessor. | ||
Class::Accessor::Faster uses an array reference underneath to be faster. | ||
Read the documentation for Class::Accessor for more info. | ||
=head1 AUTHORS | ||
Copyright 2007 Marty Pauley <[email protected]> | ||
This program is free software; you can redistribute it and/or modify it under | ||
the same terms as Perl itself. That means either (a) the GNU General Public | ||
License or (b) the Artistic License. | ||
=head1 SEE ALSO | ||
L<Class::Accessor> | ||
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,85 @@ | ||
package Devel::TypeTiny::Perl56Compat; | ||
|
||
use 5.006; | ||
use strict; | ||
use warnings; | ||
|
||
our $AUTHORITY = 'cpan:TOBYINK'; | ||
our $VERSION = '1.010000'; | ||
|
||
$VERSION =~ tr/_//d; | ||
|
||
#### B doesn't provide perlstring() in 5.6. Monkey patch it. | ||
|
||
use B (); | ||
|
||
unless (exists &B::perlstring) | ||
{ | ||
my $d; | ||
*B::perlstring = sub { | ||
no warnings 'uninitialized'; | ||
require Data::Dumper; | ||
$d ||= 'Data::Dumper'->new([])->Indent(0)->Purity(0)->Pad('')->Useqq(1)->Terse(1)->Freezer('')->Toaster(''); | ||
my $perlstring = $d->Values([''.shift])->Dump; | ||
($perlstring =~ /^"/) ? $perlstring : qq["$perlstring"]; | ||
}; | ||
} | ||
|
||
unless (exists &B::cstring) | ||
{ | ||
*B::cstring = \&B::perlstring; | ||
} | ||
|
||
push @B::EXPORT_OK, qw( perlstring cstring ); | ||
|
||
#### Done! | ||
|
||
5.6; | ||
|
||
__END__ | ||
=pod | ||
=encoding utf-8 | ||
=for stopwords pragmas | ||
=head1 NAME | ||
Devel::TypeTiny::Perl56Compat - shims to allow Type::Tiny to run on Perl 5.6.x | ||
=head1 STATUS | ||
This module is considered part of Type-Tiny's internals. It is not | ||
covered by the | ||
L<Type-Tiny stability policy|Type::Tiny::Manual::Policies/"STABILITY">. | ||
=head1 DESCRIPTION | ||
This is not considered part of Type::Tiny's public API. | ||
Currently this module just has one job: it patches L<B> to export a | ||
C<perlstring> function, as this was only added in Perl 5.8.0. | ||
=head1 BUGS | ||
Please report any bugs to | ||
L<http://rt.cpan.org/Dist/Display.html?Queue=Type-Tiny>. | ||
=head1 AUTHOR | ||
Toby Inkster E<lt>[email protected]E<gt>. | ||
=head1 COPYRIGHT AND LICENCE | ||
This software is copyright (c) 2013-2014, 2017-2020 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 contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,74 @@ | ||
package Devel::TypeTiny::Perl58Compat; | ||
|
||
use 5.006; | ||
use strict; | ||
use warnings; | ||
|
||
our $AUTHORITY = 'cpan:TOBYINK'; | ||
our $VERSION = '1.010000'; | ||
|
||
$VERSION =~ tr/_//d; | ||
|
||
#### re doesn't provide is_regexp in Perl < 5.10 | ||
|
||
eval 'require re'; | ||
|
||
unless (exists &re::is_regexp) | ||
{ | ||
require B; | ||
*re::is_regexp = sub { | ||
eval { B::svref_2object($_[0])->MAGIC->TYPE eq 'r' }; | ||
}; | ||
} | ||
|
||
#### Done! | ||
|
||
5.8; | ||
|
||
__END__ | ||
=pod | ||
=encoding utf-8 | ||
=for stopwords pragmas | ||
=head1 NAME | ||
Devel::TypeTiny::Perl58Compat - shims to allow Type::Tiny to run on Perl 5.8.x | ||
=head1 STATUS | ||
This module is considered part of Type-Tiny's internals. It is not | ||
covered by the | ||
L<Type-Tiny stability policy|Type::Tiny::Manual::Policies/"STABILITY">. | ||
=head1 DESCRIPTION | ||
This is not considered part of Type::Tiny's public API. | ||
Currently this module just has one job: it patches L<re> to provide a | ||
C<is_regexp> function, as this was only added in Perl 5.9.5. | ||
=head1 BUGS | ||
Please report any bugs to | ||
L<http://rt.cpan.org/Dist/Display.html?Queue=Type-Tiny>. | ||
=head1 AUTHOR | ||
Toby Inkster E<lt>[email protected]E<gt>. | ||
=head1 COPYRIGHT AND LICENCE | ||
This software is copyright (c) 2013-2014, 2017-2020 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. | ||
Oops, something went wrong.