This file is indexed.

/usr/share/perl5/Exception/Class/Base.pm is in libexception-class-perl 1.38-1.

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
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
package Exception::Class::Base;
$Exception::Class::Base::VERSION = '1.38';
use strict;
use warnings;

use Class::Data::Inheritable 0.02;
use Devel::StackTrace 1.20;
use Scalar::Util qw( blessed );

use base qw(Class::Data::Inheritable);

BEGIN {
    __PACKAGE__->mk_classdata('Trace');
    __PACKAGE__->mk_classdata('NoRefs');
    __PACKAGE__->NoRefs(1);

    __PACKAGE__->mk_classdata('NoContextInfo');
    __PACKAGE__->NoContextInfo(0);

    __PACKAGE__->mk_classdata('RespectOverload');
    __PACKAGE__->RespectOverload(0);

    __PACKAGE__->mk_classdata('MaxArgLength');
    __PACKAGE__->MaxArgLength(0);

    sub Fields { () }
}

use overload

    # an exception is always true
    bool => sub { 1 }, '""' => 'as_string', fallback => 1;

# Create accessor routines
BEGIN {
    my @fields = qw( message pid uid euid gid egid time trace );

    foreach my $f (@fields) {
        my $sub = sub { my $s = shift; return $s->{$f}; };

        no strict 'refs';
        *{$f} = $sub;
    }
    *error = \&message;

    my %trace_fields = (
        package => 'package',
        file    => 'filename',
        line    => 'line',
    );

    while ( my ( $f, $m ) = each %trace_fields ) {
        my $sub = sub {
            my $s = shift;
            return $s->{$f} if exists $s->{$f};

            my $frame = $s->trace->frame(0);

            return $s->{$f} = $frame ? $frame->$m() : undef;
        };
        no strict 'refs';
        *{$f} = $sub;
    }
}

sub Classes { Exception::Class::Classes() }

sub throw {
    my $proto = shift;

    $proto->rethrow if ref $proto;

    die $proto->new(@_);
}

sub rethrow {
    my $self = shift;

    die $self;
}

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;

    my $self = bless {}, $class;

    $self->_initialize(@_);

    return $self;
}

sub _initialize {
    my $self = shift;
    my %p = @_ == 1 ? ( error => $_[0] ) : @_;

    $self->{message} = $p{message} || $p{error} || '';

    $self->{show_trace} = $p{show_trace} if exists $p{show_trace};

    if ( $self->NoContextInfo() ) {
        $self->{show_trace} = 0;
        $self->{package} = $self->{file} = $self->{line} = undef;
    }
    else {
        # CORE::time is important to fix an error with some versions of
        # Perl
        $self->{time} = CORE::time();
        $self->{pid}  = $$;
        $self->{uid}  = $<;
        $self->{euid} = $>;
        $self->{gid}  = $(;
        $self->{egid} = $);

        my @ignore_class   = (__PACKAGE__);
        my @ignore_package = 'Exception::Class';

        if ( my $i = delete $p{ignore_class} ) {
            push @ignore_class, ( ref($i) eq 'ARRAY' ? @$i : $i );
        }

        if ( my $i = delete $p{ignore_package} ) {
            push @ignore_package, ( ref($i) eq 'ARRAY' ? @$i : $i );
        }

        $self->{trace} = Devel::StackTrace->new(
            ignore_class     => \@ignore_class,
            ignore_package   => \@ignore_package,
            no_refs          => $self->NoRefs,
            respect_overload => $self->RespectOverload,
            max_arg_length   => $self->MaxArgLength,
        );
    }

    my %fields = map { $_ => 1 } $self->Fields;
    while ( my ( $key, $value ) = each %p ) {
        next if $key =~ /^(?:error|message|show_trace)$/;

        if ( $fields{$key} ) {
            $self->{$key} = $value;
        }
        else {
            Exception::Class::Base->throw(
                error => "unknown field $key passed to constructor for class "
                    . ref $self );
        }
    }
}

sub context_hash {
    my $self = shift;

    return {
        time => $self->{time},
        pid  => $self->{pid},
        uid  => $self->{uid},
        euid => $self->{euid},
        gid  => $self->{gid},
        egid => $self->{egid},
    };
}

sub field_hash {
    my $self = shift;

    my $hash = {};

    for my $field ( $self->Fields ) {
        $hash->{$field} = $self->$field;
    }

    return $hash;
}

sub description {
    return 'Generic exception';
}

sub show_trace {
    my $self = shift;

    return 0 unless $self->{trace};

    if (@_) {
        $self->{show_trace} = shift;
    }

    return exists $self->{show_trace} ? $self->{show_trace} : $self->Trace;
}

sub as_string {
    my $self = shift;

    my $str = $self->full_message;
    unless ( defined $str && length $str ) {
        my $desc = $self->description;
        $str = defined $desc
            && length $desc ? "[$desc]" : "[Generic exception]";
    }

    $str .= "\n\n" . $self->trace->as_string
        if $self->show_trace;

    return $str;
}

sub full_message { $_[0]->{message} }

#
# The %seen bit protects against circular inheritance.
#
eval <<'EOF' if $] == 5.006;
sub isa {
    my ( $inheritor, $base ) = @_;
    $inheritor = ref($inheritor) if ref($inheritor);

    my %seen;

    no strict 'refs';
    my @parents = ( $inheritor, @{"$inheritor\::ISA"} );
    while ( my $class = shift @parents ) {
        return 1 if $class eq $base;

        push @parents, grep { !$seen{$_}++ } @{"$class\::ISA"};
    }
    return 0;
}
EOF

sub caught {
    my $class = shift;

    my $e = $@;

    return unless defined $e && blessed($e) && $e->isa($class);
    return $e;
}

1;

# ABSTRACT: A base class for exception objects

__END__

=pod

=head1 NAME

Exception::Class::Base - A base class for exception objects

=head1 VERSION

version 1.38

=head1 SYNOPSIS

  use Exception::Class 'MyException';

  eval { MyException->throw( error => 'I feel funny.' ) };

  print $@->error();

=head1 DESCRIPTION

This class is the base class for all exceptions created by
L<Exception::Class>. It provides a number of methods for getting
information about the exception.

=for Pod::Coverage     Classes
    caught

=head1 METHODS

=head2 MyException->Trace($boolean)

Each C<Exception::Class::Base> subclass can be set individually to
include a stacktrace when the C<as_string> method is called.  The
default is to not include a stacktrace.  Calling this method with a
value changes this behavior.  It always returns the current value
(after any change is applied).

This value is inherited by any subclasses.  However, if this value is
set for a subclass, it will thereafter be independent of the value in
C<Exception::Class::Base>.

Do not call this on the C<Exception::Class::Base> class directly or
you'll change it for all exception classes that use
L<Exception::Class>, including ones created in modules you don't
control.

This is a class method, not an object method.

=head2 MyException->NoRefs($boolean)

When a C<Devel::StackTrace> object is created, it walks through the
stack and stores the arguments which were passed to each subroutine on
the stack.  If any of these arguments are references, then that means
that the C<Devel::StackTrace> ends up increasing the refcount of these
references, delaying their destruction.

Since C<Exception::Class::Base> uses C<Devel::StackTrace> internally,
this method provides a way to tell C<Devel::StackTrace> not to store
these references.  Instead, C<Devel::StackTrace> replaces references
with their stringified representation.

This method defaults to true.  As with C<Trace()>, it is inherited by
subclasses but setting it in a subclass makes it independent
thereafter.

Do not call this on the C<Exception::Class::Base> class directly or
you'll change it for all exception classes that use
L<Exception::Class>, including ones created in modules you don't
control.

=head2 MyException->RespectOverload($boolean)

When a C<Devel::StackTrace> object stringifies, by default it ignores
stringification overloading on any objects being dealt with.

Since C<Exception::Class::Base> uses C<Devel::StackTrace> internally,
this method provides a way to tell C<Devel::StackTrace> to respect
overloading.

This method defaults to false.  As with C<Trace()>, it is inherited by
subclasses but setting it in a subclass makes it independent
thereafter.

Do not call this on the C<Exception::Class::Base> class directly or
you'll change it for all exception classes that use
L<Exception::Class>, including ones created in modules you don't
control.

=head2 MyException->MaxArgLength($boolean)

When a C<Devel::StackTrace> object stringifies, by default it displays
the full argument for each function. This parameter can be used to
limit the maximum length of each argument.

Since C<Exception::Class::Base> uses C<Devel::StackTrace> internally,
this method provides a way to tell C<Devel::StackTrace> to limit the
length of arguments.

This method defaults to 0. As with C<Trace()>, it is inherited by
subclasses but setting it in a subclass makes it independent
thereafter.

Do not call this on the C<Exception::Class::Base> class directly or
you'll change it for all exception classes that use
L<Exception::Class>, including ones created in modules you don't
control.

=head2 MyException->Fields

This method returns the extra fields defined for the given class, as
a list.

Do not call this on the C<Exception::Class::Base> class directly or
you'll change it for all exception classes that use
L<Exception::Class>, including ones created in modules you don't
control.

=head2 MyException->throw( $message )

=head2 MyException->throw( message => $message )

=head2 MyException->throw( error => $error )

This method creates a new object with the given error message.  If no
error message is given, this will be an empty string.  It then dies
with this object as its argument.

This method also takes a C<show_trace> parameter which indicates
whether or not the particular exception object being created should
show a stacktrace when its C<as_string()> method is called.  This
overrides the value of C<Trace()> for this class if it is given.

The frames included in the trace can be controlled by the C<ignore_class>
and C<ignore_package> parameters. These are passed directly to
Devel::Stacktrace's constructor. See C<Devel::Stacktrace> for more details.

If only a single value is given to the constructor it is assumed to be
the message parameter.

Additional keys corresponding to the fields defined for the particular
exception subclass will also be accepted.

=head2 MyException->new(...)

This method takes the same parameters as C<throw()>, but instead of
dying simply returns a new exception object.

This method is always called when constructing a new exception object
via the C<throw()> method.

=head2 MyException->description()

Returns the description for the given C<Exception::Class::Base>
subclass.  The C<Exception::Class::Base> class's description is
"Generic exception" (this may change in the future).  This is also an
object method.

=head2 $exception->rethrow()

Simply dies with the object as its sole argument.  It's just syntactic
sugar.  This does not change any of the object's attribute values.
However, it will cause C<caller()> to report the die as coming from
within the C<Exception::Class::Base> class rather than where rethrow
was called.

Of course, you always have access to the original stacktrace for the
exception object.

=head2 $exception->message()

=head2 $exception->error()

Returns the error/message associated with the exception.

=head2 $exception->pid()

Returns the pid at the time the exception was thrown.

=head2 $exception->uid()

Returns the real user id at the time the exception was thrown.

=head2 $exception->gid()

Returns the real group id at the time the exception was thrown.

=head2 $exception->euid()

Returns the effective user id at the time the exception was thrown.

=head2 $exception->egid()

Returns the effective group id at the time the exception was thrown.

=head2 $exception->time()

Returns the time in seconds since the epoch at the time the exception
was thrown.

=head2 $exception->package()

Returns the package from which the exception was thrown.

=head2 $exception->file()

Returns the file within which the exception was thrown.

=head2 $exception->line()

Returns the line where the exception was thrown.

=head2 $exception->context_hash()

Returns a hash reference with the following keys:

=over 4

=item * time

=item * pid

=item * uid

=item * euid

=item * gid

=item * egid

=back

=head2 $exception->field_hash()

Returns a hash reference where the keys are any fields defined for the
exception class and the values are the values associated with the field in the
given object.

=head2 $exception->trace()

Returns the trace object associated with the object.

=head2 $exception->show_trace($boolean)

This method can be used to set whether or not a stack trace is
included when the as_string method is called or the object is
stringified.

=head2 $exception->as_string()

Returns a string form of the error message (something like what you'd
expect from die).  If the class or object is set to show traces then
then the full trace is also included.  The result looks like
C<Carp::confess()>.

=head2 $exception->full_message()

Called by the C<as_string()> method to get the message.  By default,
this is the same as calling the C<message()> method, but may be
overridden by a subclass.  See below for details.

=head1 LIGHTWEIGHT EXCEPTIONS

A lightweight exception is one which records no information about its context
when it is created. This can be achieved by setting C<<
$class->NoContextInfo() >> to a true value.

You can make this the default for a class of exceptions by setting it after
creating the class:

  use Exception::Class (
      'LightWeight',
      'HeavyWeight',
  );

  LightWeight->NoContextInfo(1);

A lightweight exception does have a stack trace object, nor does it record the
time, pid, uid, euid, gid, or egid. It only has a message.

=head1 OVERLOADING

C<Exception::Class::Base> objects are overloaded so that
stringification produces a normal error message.  This just calls the
C<< $exception->as_string() >> method described above.  This means
that you can just C<print $@> after an C<eval> and not worry about
whether or not its an actual object.  It also means an application or
module could do this:

 $SIG{__DIE__} = sub { Exception::Class::Base->throw( error => join '', @_ ); };

and this would probably not break anything (unless someone was
expecting a different type of exception object from C<die()>).

=head1 OVERRIDING THE as_string METHOD

By default, the C<as_string()> method simply returns the value
C<message> or C<error> param plus a stack trace, if the class's
C<Trace()> method returns a true value or C<show_trace> was set when
creating the exception.

However, once you add new fields to a subclass, you may want to
include those fields in the stringified error.

Inside the C<as_string()> method, the message (non-stack trace)
portion of the error is generated by calling the C<full_message()>
method.  This can be easily overridden.  For example:

  sub full_message {
      my $self = shift;

      my $msg = $self->message;

      $msg .= " and foo was " . $self->foo;

      return $msg;
  }

=head1 AUTHOR

Dave Rolsky <autarch@urth.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2014 by Dave Rolsky.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut