Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 0a42f2e872
Fetching contributors…

Cannot retrieve contributors at this time

190 lines (113 sloc) 4.442 kb
package Carp::Parse::CallerInformation::Redacted;
use warnings;
use strict;
use Carp;
use Data::Dump;
use base 'Carp::Parse::CallerInformation';
=head1 NAME
Carp::Parse::CallerInformation::Redacted - Represent the parsed caller information for a line of the Carp stack trace.
=head1 DESCRIPTION
This module inherits from Carp::Parse::CallerInformation and adds the
get_redacted_arguments_list() method to it. See C<Carp::Parse::CallerInformation>
for the list of all the methods this module offers.
As a user, you should not have to create Carp::Parse::CallerInformation objects
yourself, they will get created for you by C<Carp::Parse::Redact>.
=head1 VERSION
Version 1.0.1
=cut
our $VERSION = '1.0.1';
=head1 SYNOPSIS
# Retrieve the redacted arguments array.
my $redacted_arguments_list = $caller_information->get_redacted_arguments_list();
=head1 METHODS
=head2 new()
Create a new C<Carp::Parse::CallerInformation::Redacted> object.
my $redacted_caller_information = Carp::Parse::CallerInformation::Redacted->new(
{
arguments_string => $arguments_string,
arguments_list => $arguments_list,
redacted_arguments_list => $redacted_arguments_list,
line => $line,
}
);
=cut
sub new
{
my ( $class, $data ) = @_;
# Verify parameters.
croak 'The first argument must be a hashref with the data to set on the object.'
unless defined( $data ) && UNIVERSAL::isa( $data, 'HASH' ); ## no critic (BuiltinFunctions::ProhibitUniversalIsa)
my $line = delete( $data->{'line'} );
my $arguments_string = delete( $data->{'arguments_string'} );
my $arguments_list = delete( $data->{'arguments_list'} );
my $redacted_arguments_list = delete( $data->{'redacted_arguments_list'} );
croak "The data hashref must contain the 'line' key with the original stack line"
unless defined( $line );
croak "The following parameters are not supported: " . Data::Dump::dump( $data )
if scalar( keys %$data ) != 0;
return bless(
{
line => $line,
arguments_string => $arguments_string,
arguments_list => $arguments_list,
redacted_arguments_list => $redacted_arguments_list,
},
$class,
);
}
=head2 get_redacted_arguments_list()
Return an arrayref of the arguments parsed for this caller, with the sensitive
arguments redacted out.
my $redacted_arguments_list = $caller_information->get_redacted_arguments_list();
=cut
sub get_redacted_arguments_list
{
my ( $self ) = @_;
return $self->{'redacted_arguments_list'};
}
=head2 get_redacted_line()
Return the redacted version of the original line from the stack trace.
my $redacted_line = $caller_information->get_redacted_line();
=cut
sub get_redacted_line
{
my ( $self ) = @_;
my $line = $self->get_line();
my $redacted_arguments_list = $self->get_redacted_arguments_list() || [];
my $arguments_string = $self->get_arguments_string();
$line =~ s/\(\Q$arguments_string\E\)/Data::Dump::dump( @$redacted_arguments_list )/ex;
return $line
}
=head1 AUTHOR
Kate Kirby, C<< <kate at cpan.org> >>.
Guillaume Aubert, C<< <aubertg at cpan.org> >>.
=head1 BUGS
Please report any bugs or feature requests to C<bug-carp-parse-redact at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Carp-Parse-Redact>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Carp::Parse::CallerInformation::Redacted
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Carp-Parse-Redact>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/Carp-Parse-Redact>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/Carp-Parse-Redact>
=item * Search CPAN
L<http://search.cpan.org/dist/Carp-Parse-Redact/>
=back
=head1 ACKNOWLEDGEMENTS
Thanks to ThinkGeek (L<http://www.thinkgeek.com/>) and its corporate overlords
at Geeknet (L<http://www.geek.net/>), for footing the bill while we eat pizza
and write code for them!
=head1 COPYRIGHT & LICENSE
Copyright 2012 Kate Kirby & Guillaume Aubert.
This program is free software; you can redistribute it and/or modify it
under the terms of the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
1;
Jump to Line
Something went wrong with that request. Please try again.