This file is indexed.

/usr/share/perl5/Exception/Class.pm is in libexception-class-perl 1.40-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
package Exception::Class;

use 5.008001;

use strict;
use warnings;

our $VERSION = '1.40';

use Exception::Class::Base;
use Scalar::Util qw(blessed);

our $BASE_EXC_CLASS;
BEGIN { $BASE_EXC_CLASS ||= 'Exception::Class::Base'; }

our %CLASSES;

sub import {
    my $class = shift;

    local $Exception::Class::Caller = caller();

    my %c;

    my %needs_parent;
    while ( my $subclass = shift ) {
        my $def = ref $_[0] ? shift : {};
        $def->{isa}
            = $def->{isa}
            ? ( ref $def->{isa} ? $def->{isa} : [ $def->{isa} ] )
            : [];

        $c{$subclass} = $def;
    }

    # We need to sort by length because if we check for keys in the
    # Foo::Bar:: stash, this creates a "Bar::" key in the Foo:: stash!
MAKE_CLASSES:
    foreach my $subclass ( sort { length $a <=> length $b } keys %c ) {
        my $def = $c{$subclass};

        # We already made this one.
        next if $CLASSES{$subclass};

        {
            no strict 'refs';
            foreach my $parent ( @{ $def->{isa} } ) {
                unless ( keys %{"$parent\::"} ) {
                    $needs_parent{$subclass} = {
                        parents => $def->{isa},
                        def     => $def
                    };
                    next MAKE_CLASSES;
                }
            }
        }

        $class->_make_subclass(
            subclass => $subclass,
            def => $def || {},
        );
    }

    foreach my $subclass ( keys %needs_parent ) {

        # This will be used to spot circular references.
        my %seen;
        $class->_make_parents( \%needs_parent, $subclass, \%seen );
    }
}

sub _make_parents {
    my $class    = shift;
    my $needs    = shift;
    my $subclass = shift;
    my $seen     = shift;
    my $child    = shift;    # Just for error messages.

    no strict 'refs';

    # What if someone makes a typo in specifying their 'isa' param?
    # This should catch it. Either it's been made because it didn't
    # have missing parents OR it's in our hash as needing a parent.
    # If neither of these is true then the _only_ place it is
    # mentioned is in the 'isa' param for some other class, which is
    # not a good enough reason to make a new class.
    die
        "Class $subclass appears to be a typo as it is only specified in the 'isa' param for $child\n"
        unless exists $needs->{$subclass}
        || $CLASSES{$subclass}
        || keys %{"$subclass\::"};

    foreach my $c ( @{ $needs->{$subclass}{parents} } ) {

        # It's been made
        next if $CLASSES{$c} || keys %{"$c\::"};

        die "There appears to be some circularity involving $subclass\n"
            if $seen->{$subclass};

        $seen->{$subclass} = 1;

        $class->_make_parents( $needs, $c, $seen, $subclass );
    }

    return if $CLASSES{$subclass} || keys %{"$subclass\::"};

    $class->_make_subclass(
        subclass => $subclass,
        def      => $needs->{$subclass}{def}
    );
}

sub _make_subclass {
    my $class = shift;
    my %p     = @_;

    my $subclass = $p{subclass};
    my $def      = $p{def};

    my $isa;
    if ( $def->{isa} ) {
        $isa = ref $def->{isa} ? join ' ', @{ $def->{isa} } : $def->{isa};
    }
    $isa ||= $BASE_EXC_CLASS;

    my $version_name = 'VERSION';

    my $code = <<"EOPERL";
package $subclass;

use base qw($isa);

our \$$version_name = '1.1';

1;

EOPERL

    if ( $def->{description} ) {
        ( my $desc = $def->{description} ) =~ s/([\\\'])/\\$1/g;
        $code .= <<"EOPERL";
sub description
{
    return '$desc';
}
EOPERL
    }

    my @fields;
    if ( my $fields = $def->{fields} ) {
        @fields = UNIVERSAL::isa( $fields, 'ARRAY' ) ? @$fields : $fields;

        $code
            .= "sub Fields { return (\$_[0]->SUPER::Fields, "
            . join( ", ", map {"'$_'"} @fields )
            . ") }\n\n";

        foreach my $field (@fields) {
            $code .= sprintf( "sub %s { \$_[0]->{%s} }\n", $field, $field );
        }
    }

    if ( my $alias = $def->{alias} ) {
        die "Cannot make alias without caller"
            unless defined $Exception::Class::Caller;

        no strict 'refs';
        *{"$Exception::Class::Caller\::$alias"}
            = sub { $subclass->throw(@_) };
    }

    if ( my $defaults = $def->{defaults} ) {
        $code
            .= "sub _defaults { return shift->SUPER::_defaults, our \%_DEFAULTS }\n";
        no strict 'refs';
        *{"$subclass\::_DEFAULTS"} = {%$defaults};
    }

    eval $code;

    die $@ if $@;

    $CLASSES{$subclass} = 1;
}

sub caught {
    my $e = $@;

    return $e unless $_[1];

    return unless blessed($e) && $e->isa( $_[1] );
    return $e;
}

sub Classes { sort keys %Exception::Class::CLASSES }

1;

# ABSTRACT: A module that allows you to declare real exception classes in Perl

__END__

=pod

=head1 NAME

Exception::Class - A module that allows you to declare real exception classes in Perl

=head1 VERSION

version 1.40

=head1 SYNOPSIS

  use Exception::Class (
      'MyException',

      'AnotherException' => { isa => 'MyException' },

      'YetAnotherException' => {
          isa         => 'AnotherException',
          description => 'These exceptions are related to IPC'
      },

      'ExceptionWithFields' => {
          isa    => 'YetAnotherException',
          fields => [ 'grandiosity', 'quixotic' ],
          alias  => 'throw_fields',
      },
  );
  use Scalar::Util qw( blessed );
  use Try::Tiny;

  try {
      MyException->throw( error => 'I feel funny.' );
  }
  catch {
      die $_ unless blessed $_ && $_->can('rethrow');

      if ( $_->isa('Exception::Class') ) {
          warn $_->error, "\n", $_->trace->as_string, "\n";
          warn join ' ', $_->euid, $_->egid, $_->uid, $_->gid, $_->pid, $_->time;

          exit;
      }
      elsif ( $_->isa('ExceptionWithFields') ) {
          if ( $_->quixotic ) {
              handle_quixotic_exception();
          }
          else {
              handle_non_quixotic_exception();
          }
      }
      else {
          $_->rethrow;
      }
  };

  # without Try::Tiny
  eval { ... };
  if ( my $e = Exception::Class->caught() ) { ... }

  # use an alias - without parens subroutine name is checked at
  # compile time
  throw_fields error => "No strawberry", grandiosity => "quite a bit";

=head1 DESCRIPTION

B<RECOMMENDATION 1>: If you are writing modern Perl code with L<Moose> or
L<Moo> I highly recommend using L<Throwable> instead of this module.

B<RECOMMENDATION 2>: Whether or not you use L<Throwable>, you should use
L<Try::Tiny>.

Exception::Class allows you to declare exception hierarchies in your
modules in a "Java-esque" manner.

It features a simple interface allowing programmers to 'declare'
exception classes at compile time. It also has a base exception
class, L<Exception::Class::Base>, that can be easily extended.

It is designed to make structured exception handling simpler and
better by encouraging people to use hierarchies of exceptions in their
applications, as opposed to a single catch-all exception class.

This module does not implement any try/catch syntax. Please see the
"OTHER EXCEPTION MODULES (try/catch syntax)" section for more
information on how to get this syntax.

You will also want to look at the documentation for
L<Exception::Class::Base>, which is the default base class for all
exception objects created by this module.

=for Pod::Coverage     Classes
    caught

=head1 DECLARING EXCEPTION CLASSES

Importing C<Exception::Class> allows you to automagically create
L<Exception::Class::Base> subclasses. You can also create subclasses
via the traditional means of defining your own subclass with C<@ISA>.
These two methods may be easily combined, so that you could subclass
an exception class defined via the automagic import, if you desired
this.

The syntax for the magic declarations is as follows:

'MANDATORY CLASS NAME' => \%optional_hashref

The hashref may contain the following options:

=over 4

=item * isa

This is the class's parent class. If this isn't provided then the
class name in C<$Exception::Class::BASE_EXC_CLASS> is assumed to be
the parent (see below).

This parameter lets you create arbitrarily deep class hierarchies.
This can be any other L<Exception::Class::Base> subclass in your
declaration I<or> a subclass loaded from a module.

To change the default exception class you will need to change the
value of C<$Exception::Class::BASE_EXC_CLASS> I<before> calling
C<import()>. To do this simply do something like this:

  BEGIN { $Exception::Class::BASE_EXC_CLASS = 'SomeExceptionClass'; }

If anyone can come up with a more elegant way to do this please let me
know.

CAVEAT: If you want to automagically subclass an
L<Exception::Class::Base> subclass loaded from a file, then you
I<must> compile the class (via use or require or some other magic)
I<before> you import C<Exception::Class> or you'll get a compile time
error.

=item * fields

This allows you to define additional attributes for your exception
class. Any field you define can be passed to the C<throw()> or
C<new()> methods as additional parameters for the constructor. In
addition, your exception object will have an accessor method for the
fields you define.

This parameter can be either a scalar (for a single field) or an array
reference if you need to define multiple fields.

Fields will be inherited by subclasses.

=item * alias

Specifying an alias causes this class to create a subroutine of the
specified name in the I<caller's> namespace. Calling this subroutine
is equivalent to calling C<< <class>->throw(@_) >> for the given
exception class.

Besides convenience, using aliases also allows for additional compile
time checking. If the alias is called I<without parentheses>, as in
C<throw_fields "an error occurred">, then Perl checks for the
existence of the C<throw_fields()> subroutine at compile time. If
instead you do C<< ExceptionWithFields->throw(...) >>, then Perl
checks the class name at runtime, meaning that typos may sneak
through.

=item * description

Each exception class has a description method that returns a fixed
string. This should describe the exception I<class> (as opposed to
any particular exception object). This may be useful for debugging if
you start catching exceptions you weren't expecting (particularly if
someone forgot to document them) and you don't understand the error
messages.

=back

The C<Exception::Class> magic attempts to detect circular class
hierarchies and will die if it finds one. It also detects missing
links in a chain, for example if you declare Bar to be a subclass of
Foo and never declare Foo.

=head1 L<Try::Tiny>

If you are interested in adding try/catch/finally syntactic sugar to your code
then I recommend you check out L<Try::Tiny>. This is a great module that helps
you ignore some of the weirdness with C<eval> and C<$@>. Here's an example of
how the two modules work together:

  use Exception::Class ( 'My::Exception' );
  use Scalar::Util qw( blessed );
  use Try::Tiny;

  try {
      might_throw();
  }
  catch {
      if ( blessed $_ && $_->isa('My::Exception') ) {
          handle_it();
      }
      else {
          die $_;
      }
  };

Note that you B<cannot> use C<< Exception::Class->caught() >> with
L<Try::Tiny>.

=head1 Catching Exceptions Without L<Try::Tiny>

C<Exception::Class> provides some syntactic sugar for catching
exceptions in a safe manner:

  eval {...};

  if ( my $e = Exception::Class->caught('My::Error') ) {
      cleanup();
      do_something_with_exception($e);
  }

The C<caught()> method takes a class name and returns an exception
object if the last thrown exception is of the given class, or a
subclass of that class. If it is not given any arguments, it simply
returns C<$@>.

You should B<always> make a copy of the exception object, rather than
using C<$@> directly. This is necessary because if your C<cleanup()>
function uses C<eval>, or calls something which uses it, then C<$@> is
overwritten. Copying the exception preserves it for the call to
C<do_something_with_exception()>.

Exception objects also provide a caught method so you can write:

  if ( my $e = My::Error->caught() ) {
      cleanup();
      do_something_with_exception($e);
  }

=head2 Uncatchable Exceptions

Internally, the C<caught()> method will call C<isa()> on the exception
object. You could make an exception "uncatchable" by overriding
C<isa()> in that class like this:

 package Exception::Uncatchable;

 sub isa { shift->rethrow }

Of course, this only works if you always call C<< Exception::Class->caught()
>> after an C<eval>.

=head1 USAGE RECOMMENDATION

If you're creating a complex system that throws lots of different
types of exceptions, consider putting all the exception declarations
in one place. For an app called Foo you might make a
C<Foo::Exceptions> module and use that in all your code. This module
could just contain the code to make C<Exception::Class> do its
automagic class creation. Doing this allows you to more easily see
what exceptions you have, and makes it easier to keep track of them.

This might look something like this:

  package Foo::Bar::Exceptions;

  use Exception::Class (
      Foo::Bar::Exception::Senses =>
          { description => 'sense-related exception' },

      Foo::Bar::Exception::Smell => {
          isa         => 'Foo::Bar::Exception::Senses',
          fields      => 'odor',
          description => 'stinky!'
      },

      Foo::Bar::Exception::Taste => {
          isa         => 'Foo::Bar::Exception::Senses',
          fields      => [ 'taste', 'bitterness' ],
          description => 'like, gag me with a spoon!'
      },

      ...
  );

You may want to create a real module to subclass
L<Exception::Class::Base> as well, particularly if you want your
exceptions to have more methods.

=head2 Subclassing Exception::Class::Base

As part of your usage of C<Exception::Class>, you may want to create
your own base exception class which subclasses
L<Exception::Class::Base>. You should feel free to subclass any of
the methods documented above. For example, you may want to subclass
C<new()> to add additional information to your exception objects.

=head1 Exception::Class FUNCTIONS

The C<Exception::Class> method offers one function, C<Classes()>,
which is not exported. This method returns a list of the classes that
have been created by calling the C<Exception::Class> import() method.
Note that this is I<all> the subclasses that have been created, so it
may include subclasses created by things like CPAN modules, etc. Also
note that if you simply define a subclass via the normal Perl method
of setting C<@ISA> or C<use base>, then your subclass will not be
included.

=head1 SUPPORT

Please submit bugs to the CPAN RT system at
http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Exception%3A%3AClass or
via email at bug-exception-class@rt.cpan.org.

=head1 DONATIONS

If you'd like to thank me for the work I've done on this module,
please consider making a "donation" to me via PayPal. I spend a lot of
free time creating free software, and would appreciate any support
you'd care to offer.

Please note that B<I am not suggesting that you must do this> in order
for me to continue working on this particular software. I will
continue to do so, inasmuch as I have in the past, for as long as it
interests me.

Similarly, a donation made in this way will probably not make me work
on this software much more, unless I get so many donations that I can
consider working on free software full time, which seems unlikely at
best.

To donate, log into PayPal and send money to autarch@urth.org or use
the button on this page:
L<http://www.urth.org/~autarch/fs-donation.html>

=head1 AUTHOR

Dave Rolsky <autarch@urth.org>

=head1 CONTRIBUTOR

=for stopwords Ricardo Signes

Ricardo Signes <rjbs@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2016 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