package Hooks::Simple; 

=head1 NAME

Hooks::Simple - A simple, uniform way to set chained hooks.

=head1 SYNOPSIS

  use Hooks::Simple(
    BEGIN => sub { print "Starting...\n"    },
    END   => sub { print "Ending...\n"      },
    WARN  => sub { print "Warning: ", shift },
    DIE   => sub { print "I'm hit!\n"       },
    DIE   => sub { print "To the death!\n"  },
  );

=head1 DESCRIPTION

This module provides a simple, uniform way to set chained
hooks in a Perl script.  Because they are chained, you
can define multiple handlers for a single hook and they
will be called in the order that they are defined.

Previously defined handlers, whether they were set via
this module or not, will be preserved and called I<before>
the hooks set via this module (except for END hooks, see
below).

Currently supported hooks are:

=over 4

=item BEGIN

Executed during compilation, immediately after
the handlers for all the other hooks are set up,
before returning from the C<use>.

So, if you C<die()> inside your BEGIN handler, any
handlers you set for DIE will be called.

=item END

Executed just before the script quits (even after
any DIE handlers are called).

Note that, unlike when you define a END subroutine,
these handlers are called I<in the order you define
them>.  Normal END subroutines are called in reverse
order and these handlers are called as if they were
all part of a single END subroutine that occurs at
the C<use> line.

For example, the following code:

  END { print "End 1\n" }
  use Hooks::Simple(
    END => sub { print "End 2\n" },
    END => sub { print "End 3\n" },
  );
  END { print "End 4\n" }

Would print:

  End 4
  End 2
  End 3
  End 1

=item WARN

Executed whenever a warning is generated.

The text of the warning is passed as the first parameter
to I<every> handler and is I<not> printed after all the
handlers have been called.

=item DIE

Executed whenever the program C<die()>'s.

The text of the error is passed as the first parameter
to I<every> handler and is printed to STDERR after all
the handlers have been called.

=item SIGNALS

Any hook other than the ones listed previously are
considered signals and are passed unchecked to %SIG.
If you specify a signal that is not supported on your
system, it will cause a warning.

When a signal is triggered, all the handlers for that signal
are called, in order.  It would be possible to set it up
so that only a single handler is called when a signal is
triggered and then removed from the queue so that the
next time the signal is triggered, the next handler is
called.  But that would be inconsistant with how the
other hooks are handled so I will leave that for a
different module.

Note that SIGALRM is somewhat complicated since you also
need to setup an alarm to trigger the signal.  When the
alarm goes off, all the handlers are called.  If you want
"logical" behaviour, check out Alarm::Queued and/or
Alarm::Concurrent.  Those modules also have the (somewhat
dubious) ability to prevent other code from modifying
%SIG.  This feature may be implemented for this module
in the future.

=back

=head1 CAVEATS

Any hooks that rely on %SIG (including WARN and DIE)
are subsceptible to problems if you modify %SIG.
If you modify, or make any calls to code that modifies,
the elements of %SIG corresponding to handlers you have
installed and don't take care to localize those changes,
your handlers will be lost.

=cut

use strict;
use Carp;

use vars qw/ %HOOKS /;
%HOOKS = ();

sub import {
  my $pkg = shift;

  croak("Odd number of arguments to Hooks::Simple") if(@_ % 2);

  while(@_) {
    my ($key, $code) = (shift, shift);

    if( UNIVERSAL::isa($code, 'CODE') ) {
      push @{$HOOKS{$key}}, $code;
    } else {
      croak("Handler not a CODE reference");
    }
  }

  # Save old WARN and DIE handlers, just in case.
  unshift(@{$HOOKS{DIE}},  $SIG{__DIE__})  if $SIG{__DIE__};
  unshift(@{$HOOKS{WARN}}, $SIG{__WARN__}) if $SIG{__WARN__};

  # Install our custom WARN and DIE handlers.
  $SIG{__DIE__}  = sub { $_->(@_) for(@{$HOOKS{DIE}}) };
  $SIG{__WARN__} = sub { $_->(@_) for(@{$HOOKS{WARN}}) };

  # Install misc. signal handlers.
  my @sigkeys = grep !/^(?:BEGIN|END|WARN|DIE)$/, keys %HOOKS;
  for my $sig (@sigkeys) {
    # Save old handler, if present.
    unshift(@{$HOOKS{$sig}}, $SIG{$sig}) if $SIG{$sig};
    # Install our handler routine.
    $SIG{$sig} = sub { $_->(@_) for(@{$HOOKS{$sig}}) };
  }

  $_->() for(@{$HOOKS{BEGIN}}); # Call all the begin hooks
}

sub END {
  $_->(@_) for(@{$HOOKS{END}}); # Call all the end hooks
}

1;