/usr/share/perl5/Mixin/ExtraFields/Param.pm is in libmixin-extrafields-param-perl 0.011-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 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 | use warnings;
use strict;
package Mixin::ExtraFields::Param;
use base qw(Mixin::ExtraFields);
use Carp ();
=head1 NAME
Mixin::ExtraFields::Param - make your class provide a familiar "param" method
=head1 VERSION
version 0.011
$Id: /my/cs/projects/Mixin-ExtraFields-Param/trunk/lib/Mixin/ExtraFields/Param.pm 29059 2006-12-11T03:20:29.045283Z rjbs $
=cut
our $VERSION = '0.011';
=head1 SYNOPSIS
package Widget::Parametric;
use Mixin::ExtraFields::Param -fields => { driver => 'HashGuts' };;
...
my $widget = Widget::Parametric->new({ flavor => 'vanilla' });
printf "%s: %s\n", $_, $widget->param($_) for $widget->param;
=head1 DESCRIPTION
This module mixes in to your class to provide a C<param> method like the ones
provided by L<CGI>, L<CGI::Application>, and other classes. It uses
Mixin::ExtraFields, which means it can use any Mixin::ExtraFields driver to
store your data.
By default, the methods provided are:
=over
=item * param
=item * exists_param
=item * delete_param
=back
These methods are imported by the C<fields> group, which must be requested. If
a C<moniker> argument is supplied, the moniker is used instead of "param". For
more information, see L<Mixin::ExtraFields>.
=cut
sub default_moniker { 'param' }
sub methods { qw(param exists delete) }
sub method_name {
my ($self, $method, $moniker) = @_;
return $moniker if $method eq 'param';
return $self->SUPER::method_name($method, $moniker);
}
sub build_method {
my ($self, $method_name, $arg) = @_;
return $self->_build_param_method($arg) if $method_name eq 'param';
return $self->SUPER::build_method($method_name, $arg);
}
=head1 METHODS
=cut
=head2 param
my @params = $object->param; # get names of existing params
my $value = $object->param('name'); # get value of a param
my $value = $object->param(name => $value); # set a param's value
my @values = $object->param(n1 => $v1, n2 => $v2, ...); # set many values
This method sets or retrieves parameters.
=cut
sub _build_param_method {
my ($self, $arg) = @_;
my $id_method = $arg->{id_method};
my $driver = $arg->{driver};
my $names_method = $self->driver_method_name('get_all_names');
my $get_method = $self->driver_method_name('get');
my $set_method = $self->driver_method_name('set');
sub {
my $self = shift;
my $id = $self->$$id_method;
# If called as ->param, return all names.
return $$driver->$names_method($self, $id) unless @_;
# If given a hashref, as first arg, operate on its contents. In the
# future, we might want to complain if we get a hashref /and/ further
# arguments.
@_ = %{$_[0]} if @_ == 1 and ref $_[0] eq 'HASH';
Carp::croak "invalid call to param: odd, non-one number of params"
if @_ > 1 and @_ % 2 == 1;
# If called as ->param($name), return the value
return $$driver->$get_method($self, $id, $_[0]) if @_ == 1;
# Otherwise we're doing... BULK ASSIGNMENT!
my @assigned;
while (@_) {
# We don't put @_ into a hash because we guarantee processing (and more
# importantly return) order. -- rjbs, 2006-03-14
my ($key, $value) = splice @_, 0, 2;
$$driver->$set_method($self, $id, $key => $value);
push @assigned, $value;
}
return wantarray ? @assigned : $assigned[0];
};
}
=head1 AUTHOR
Ricardo SIGNES, C<< <rjbs@cpan.org> >>
=head1 BUGS
Please report any bugs or feature requests to L<http://rt.cpan.org>, for
Mixin-ExtraFields-Param. I will be notified, and then you'll automatically be
notified of progress on your bug as I make changes.
=head1 COPYRIGHT
Copyright 2005-2006 Ricardo Signes, all rights reserved.
This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
1;
|