/usr/share/perl5/CGI/Application/Plugin/ActionDispatch/Attributes.pm is in libcgi-application-plugin-actiondispatch-perl 0.99-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 | package CGI::Application::Plugin::ActionDispatch::Attributes;
use attributes;
use strict;
use Data::Dumper;
our $VERSION = '0.1';
my @attributes;
my %attr_handlers;
my %inited; # Allow multiple CGI::Applications to be inited separately in mod_perl enivironment
# MODIFY_CODE_ATTRIBUTES needs to be in the inheritance tree.
push @CGI::Application::ISA, 'CGI::Application::Plugin::ActionDispatch::Attributes'
unless grep /^CGI::Application::Plugin::ActionDispatch::Attributes$/, @CGI::Application::ISA;
sub MODIFY_CODE_ATTRIBUTES {
my($class, $code, @attrs) = @_;
foreach (@attrs) {
# Parse the attribute string ex: Regex('^/foo/bar/(\d+)/').
my($method, $params) = /^(.*?)(?:\(\s*(.+?)\s*\))?$/;
if (defined $params) {
($params =~ s/^'(.*)'$/$1/) || ($params =~ s/^"(.*)"/$1/)
}
# Attribute definition.
if($method eq 'ATTR') {
$attr_handlers{$code} = $params
}
# Is a custom attribute.
else {
my $handler = $class->can($method);
next unless $handler;
push(@attributes, [ $class, $method, $code, $params ] );
}
}
return ();
}
sub init {
my $class;
foreach my $attr (@attributes) {
$class = $attr->[0];
next if( exists $inited{$class});
my $method = $attr->[1];
# calls: class->method( code, method, params );
$class->$method( $attr->[2], $attr->[1], $attr->[3]);
}
$inited{$class}++; # Mark our caller class inited now, so that it can be skipped on next run
}
1;
__END__
=head1 NAME
CGI::Application::Plugin::ActionDispatch::Attributes - Hidden attribute support for CGI::Application
=head1 SYNOPSIS
use CGI::Application::Plugin::ActionDispatch::Attributes;
sub CGI::Application::Protected : ATTR {
my( $package, $referent, $attr, $data ) = @_;
...
}
CGI::Application::Plugin::ActionDispatch::Attributes::init();
sub my_method Protected {
...
}
=head1 DESCRIPTION
This module will add attribute support into CGI::Application. It will
also not break mod_perl.
T
=head1 SEE ALSO
=head1 AUTHOR
Jason Yates, E<lt>jaywhy@gmail.comE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2006-2008 by Jason Yates
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.
=cut
|