The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

use	strict;

use Test::More tests => 5;

# Record the subroutines we've seen in a session
my @Event_History;

sub	main::record_event {
	my ($hook_name)	= @_;

	my $sub		= (caller 1)[3];

	push @Event_History, "$hook_name/$sub";
}


BEGIN {	use_ok('CGI::Application') };


######################################
{
	package	CGI::Application::Plugin::Foo;
	use	vars qw/@EXPORT	@ISA/;
	@ISA	   = ('Exporter');
	@EXPORT	   = qw(
		foo_custom
		foo_init1
		foo_init2
		foo_prerun
		foo_postrun
		foo_teardown
	);

	sub	import {
		my $caller = caller;
		$caller->new_hook('foo_hook');

		# Foo's hooks are added by reference.  They cannot be overridden by the
		# application

		$caller->add_callback('foo_hook', \&foo_custom);
		$caller->add_callback('init',     \&foo_init1);
		$caller->add_callback('init',     \&foo_init2);
		$caller->add_callback('prerun',   \&foo_prerun);
		$caller->add_callback('postrun',  \&foo_postrun);
		$caller->add_callback('teardown', \&foo_teardown);
		goto &Exporter::import;
	}
	sub	foo_custom	 { main::record_event('foo_hook') }
	sub	foo_init1	 { main::record_event('init')     }
	sub	foo_init2	 { main::record_event('init')     }
	sub	foo_prerun	 { main::record_event('prerun')   }
	sub	foo_postrun	 { main::record_event('postrun')  }
	sub	foo_teardown {
		my $self = shift;
		main::record_event('teardown');
		$self->call_hook('foo_hook');
	}

}
######################################
{
	package	CGI::Application::Plugin::Bar;
	use	vars qw/@EXPORT	@ISA/;
	@ISA	   = ('Exporter');
	@EXPORT	   = qw(
		bar_custom
		bar_init1
		bar_init2
		bar_prerun
		bar_postrun
		bar_teardown
	);


	sub	import {
		my $caller = caller;
		$caller->new_hook('bar_hook');
		$caller->add_callback('bar_hook', 'bar_custom');
		$caller->add_callback('init',     'bar_init1');
		$caller->add_callback('init',     'bar_init2');
		$caller->add_callback('prerun',   'bar_prerun');
		$caller->add_callback('postrun',  'bar_postrun');
		$caller->add_callback('teardown', 'bar_teardown');
		goto &Exporter::import;
	}
	sub	bar_custom	 { main::record_event('bar_hook')    }
	sub	bar_init1	 {
		my $self = shift;
		main::record_event('init');
		$self->call_hook('bar_hook');
	}
	sub	bar_init2	 { main::record_event('init')     }
	sub	bar_prerun	 { main::record_event('prerun')   }
	sub	bar_postrun	 { main::record_event('postrun')  }
	sub	bar_teardown { main::record_event('teardown') }

}
######################################
{
	package	CGI::Application::Plugin::Baz;
	use	vars qw/@EXPORT	@ISA/;
	@ISA	   = ('Exporter');
	@EXPORT	   = qw(
		baz_custom
		baz_init1
		baz_init2
		baz_prerun
		baz_postrun
		baz_teardown
	);

	sub	import {
		my $caller = caller;
		$caller->new_hook('baz_hook');
		$caller->add_callback('baz_hook', 'baz_custom');
		$caller->add_callback('init',     'baz_init1');
		$caller->add_callback('init',     'baz_init2');
		$caller->add_callback('prerun',   'baz_prerun');
		$caller->add_callback('postrun',  'baz_postrun');
		$caller->add_callback('teardown', 'baz_teardown');
		goto &Exporter::import;
	}
	sub	baz_custom	 { main::record_event('baz_hook')  }
	sub	baz_init1	 { main::record_event('init')      }
	sub	baz_init2	 { main::record_event('init')      }
	sub	baz_prerun	 {
		my $self = shift;
		main::record_event('prerun');
		$self->call_hook('baz_hook');
	}
	sub	baz_postrun	 { main::record_event('postrun')   }
	sub	baz_teardown { main::record_event('teardown')  }

}
######################################
{
	package	CGI::Application::Plugin::Bam;
	use	vars qw/@EXPORT	@ISA/;
	@ISA	   = ('Exporter');
	@EXPORT	   = qw(
		bam_custom
		bam_init1
		bam_init2
		bam_prerun
		bam_postrun
		bam_teardown
	);


	sub	import {
		my $caller = caller;
		$caller->new_hook('bam_hook');
		$caller->add_callback('bam_hook', 'bam_custom');
		$caller->add_callback('init',     'bam_init1');
		$caller->add_callback('init',     'bam_init2');
		$caller->add_callback('prerun',   'bam_prerun');
		$caller->add_callback('postrun',  'bam_postrun');
		$caller->add_callback('teardown', 'bam_teardown');
		goto &Exporter::import;
	}

	sub	bam_custom	 { main::record_event('bam_hook') }
	sub	bam_init1	 { main::record_event('init')     }
	sub	bam_init2	 { main::record_event('init')     }
	sub	bam_prerun	 { main::record_event('prerun')   }
	sub	bam_postrun	 {
		my $self = shift;
		main::record_event('postrun');
		$self->call_hook('bam_hook');
	}
	sub	bam_teardown { main::record_event('teardown')  }

}

######################################
{
	package	My::Framework;
    use vars qw/@ISA/;
    @ISA = ('CGI::Application');
	sub	cgiapp_init	   { main::record_event('init')       }
	sub	cgiapp_prerun  { main::record_event('prerun')     }
	sub	cgiapp_postrun { main::record_event('postrun')    }
	sub	teardown	   { main::record_event('teardown')   }
}

######################################
{
	package	My::Project;
    use vars qw/@ISA/;
	@ISA = ('My::Framework');
	import CGI::Application::Plugin::Foo;

	# install another init callback	for	all	users of My::Project
	My::Project->add_callback('init',      'my_project_init');

	# install an impolite callback that	will get run by	all	CGI::Application apps
	# regardless of	whether	or not they	use	My::Project
	CGI::Application->add_callback('init', \&my_project_global_init);

	sub	my_project_init	{ main::record_event('init')          }
	sub	my_project_global_init { main::record_event('init')   }

}

######################################
{
	package	Other::Project;
    use vars qw/@ISA/;
    @ISA = ('My::Framework');
	import CGI::Application::Plugin::Baz;
	import CGI::Application::Plugin::Bam;

	# install another init callback	for	all	users of Other::Project
	Other::Project->add_callback('init',      'other_project_init');

	# install an impolite callback that	will get run by	all	CGI::Application apps
	# regardless of	whether	or not they	use	My::Project
	CGI::Application->add_callback('init', \&other_project_global_init);

	sub	other_project_init { main::record_event('init')          }
	sub	other_project_global_init {	main::record_event('init')   }

}

######################################
{
	package	My::App;
    use vars qw/@ISA/;
    @ISA = ('My::Project');
	import CGI::Application::Plugin::Bar;

	sub	setup {
		my $self = shift;
		$self->header_type('none');
		$self->run_modes(['begin']);
		$self->start_mode('begin');
	}
	sub	cgiapp_init		{
		my $self = shift;
		main::record_event('init');
		__PACKAGE__->add_callback('prerun', 'my_app_class_prerun');
		__PACKAGE__->add_callback('teardown', 'my_app_teardown');
		$self->add_callback('teardown', 'my_app_teardown');
	}
	sub	cgiapp_prerun		{ main::record_event('prerun')      }
	sub	my_app_class_prerun	{ main::record_event('prerun')      }
	sub	my_app_obj_prerun	{ main::record_event('prerun')      }
	sub	my_app_teardown		{ main::record_event('teardown')    }
	sub	cgiapp_postrun		{ main::record_event('postrun')     }
	sub	teardown			{ main::record_event('teardown')    }

	sub	begin {
		main::record_event('runmode');
		return '';
	}

}

######################################
{
	package	Other::App;
    use vars qw/@ISA/;
    @ISA = 'Other::Project';

	import CGI::Application::Plugin::Bam;

	sub	setup {
		my $self = shift;
		$self->header_type('none');
		$self->run_modes(['begin']);
		$self->start_mode('begin');
	}
	sub	cgiapp_init		{
		my $self = shift;
		$self->add_callback('postrun', 'other_app_postrun');
		main::record_event('init')
	}
	sub	cgiapp_prerun	   { main::record_event('prerun')      }
	sub	cgiapp_postrun	   { main::record_event('postrun')     }
	sub	other_app_postrun  { main::record_event('postrun')     }
	sub	teardown		   { main::record_event('teardown')    }

	sub	begin {
		main::record_event('runmode');
		return '';
	}
}

{
	package	Unrelated::App;
    use vars qw/@ISA/;
    @ISA = ('CGI::Application');

	sub	setup {
		my $self = shift;
		$self->header_type('none');
		$self->run_modes(['begin']);
		$self->start_mode('begin');
	}
	sub	cgiapp_init		{ main::record_event('init')        }
	sub	cgiapp_prerun	{ main::record_event('prerun')      }
	sub	cgiapp_postrun	{ main::record_event('postrun')     }
	sub	teardown		{ main::record_event('teardown')    }

	sub	begin {
		main::record_event('runmode');
		return '';
	}
}


@Event_History = ();

my $app	= My::App->new;
$app->add_callback('prerun', 'my_app_obj_prerun');
$app->run;

my @expected_events	= (
	# init

	'init/CGI::Application::Plugin::Bar::bar_init1',        # CAP::Bar
	'bar_hook/CGI::Application::Plugin::Bar::bar_custom',
	'init/CGI::Application::Plugin::Bar::bar_init2',

	'init/CGI::Application::Plugin::Foo::foo_init1',        # CAP::Foo
	'init/CGI::Application::Plugin::Foo::foo_init2',


	'init/My::Project::my_project_init',                   # My::Project

	'init/My::App::cgiapp_init',                           # My::App (but installed via CGI::Application)

	'init/My::Project::my_project_global_init',            # My::Project (rudely) registered a callback in the
														   # CGI::Application class

	'init/Other::Project::other_project_global_init',      # Other::Project (rudely) registered a callback in the
														   # CGI::Application class, which forces us to	run	it


	# prerun

	'prerun/My::App::my_app_obj_prerun',                   # My::App (installed in object)

	'prerun/CGI::Application::Plugin::Bar::bar_prerun',    # CAP::Foo

	'prerun/My::App::my_app_class_prerun',                 # My::App (but installed at runtime)

	'prerun/CGI::Application::Plugin::Foo::foo_prerun',    # CAP::Bar

	'prerun/My::App::cgiapp_prerun',                       # My::App (but installed via CGI::Application)


	# Run mode
	'runmode/My::App::begin',                              # My::App

	# postrun
	'postrun/CGI::Application::Plugin::Bar::bar_postrun',  # CAP::Bar
	'postrun/CGI::Application::Plugin::Foo::foo_postrun',  # CAP::Foo
	'postrun/My::App::cgiapp_postrun',                     # My::App (but installed via CGI::Application)

	# teardown
	'teardown/My::App::my_app_teardown',                   # My::App (but installed in object)

	'teardown/CGI::Application::Plugin::Bar::bar_teardown',  # CAP::Bar
	'teardown/CGI::Application::Plugin::Foo::foo_teardown',  # CAP::Foo
	'foo_hook/CGI::Application::Plugin::Foo::foo_custom',    # CAP::Foo
	'teardown/My::App::teardown',                            # My::App (but installed via CGI::Application)

);


is_deeply(\@Event_History, \@expected_events, 'My::App - callbacks executed correctly (first run)')
   or do {
		use	Data::Dumper;
		print STDERR "Actual Event History: \n";
		print STDERR Dumper	\@Event_History;
};

# Second run of	My::App	: the callback registered directly in self are
# no longer	installed

@Event_History = ();

My::App->new->run;

@expected_events = (
	# init

	'init/CGI::Application::Plugin::Bar::bar_init1',        # CAP::Bar
	'bar_hook/CGI::Application::Plugin::Bar::bar_custom',
	'init/CGI::Application::Plugin::Bar::bar_init2',

	'init/CGI::Application::Plugin::Foo::foo_init1',        # CAP::Foo
	'init/CGI::Application::Plugin::Foo::foo_init2',


	'init/My::Project::my_project_init',                   # My::Project

	'init/My::App::cgiapp_init',                           # My::App (but installed via CGI::Application)

	'init/My::Project::my_project_global_init',            # My::Project (rudely) registered a callback in the
														   # CGI::Application class

	'init/Other::Project::other_project_global_init',      # Other::Project (rudely) registered a callback in the
														   # CGI::Application class, which forces us to	run	it


	# prerun


	'prerun/CGI::Application::Plugin::Bar::bar_prerun',    # CAP::Foo

	'prerun/My::App::my_app_class_prerun',                 # My::App (but installed at runtime)


	'prerun/CGI::Application::Plugin::Foo::foo_prerun',    # CAP::Bar

	'prerun/My::App::cgiapp_prerun',                       # My::App (but installed via CGI::Application)


	# Run mode
	'runmode/My::App::begin',                              # My::App

	# postrun
	'postrun/CGI::Application::Plugin::Bar::bar_postrun',  # CAP::Bar
	'postrun/CGI::Application::Plugin::Foo::foo_postrun',  # CAP::Foo
	'postrun/My::App::cgiapp_postrun',                     # My::App (but installed via CGI::Application)

	# teardown
	'teardown/My::App::my_app_teardown',                   # My::App (but installed in object)

	'teardown/CGI::Application::Plugin::Bar::bar_teardown',  # CAP::Bar
	'teardown/CGI::Application::Plugin::Foo::foo_teardown',  # CAP::Foo
	'foo_hook/CGI::Application::Plugin::Foo::foo_custom',    # CAP::Foo
	'teardown/My::App::teardown',                            # My::App (but installed via CGI::Application)

);


is_deeply(\@Event_History, \@expected_events, 'My::App - callbacks executed correctly (second run)')
   or do {
		use	Data::Dumper;
		print STDERR "Actual Event History: \n";
		print STDERR Dumper	\@Event_History;
};











@Event_History = ();
Other::App->new->run;

@expected_events = (
	# init

	'init/CGI::Application::Plugin::Bam::bam_init1',        # CAP::Bam
	'init/CGI::Application::Plugin::Bam::bam_init2',

	'init/CGI::Application::Plugin::Baz::baz_init1',        # CAP::Baz
	'init/CGI::Application::Plugin::Baz::baz_init2',


	'init/Other::Project::other_project_init',             # Other::Project

	'init/Other::App::cgiapp_init',                        # Other::App (but installed via CGI::Application)

	'init/My::Project::my_project_global_init',            # My::Project (rudely) registered a callback in the
														   # CGI::Application class, which forces us to	run	it

	'init/Other::Project::other_project_global_init',      # Other::Project (rudely) registered a callback in the
														   # CGI::Application class


	# prerun


	'prerun/CGI::Application::Plugin::Bam::bam_prerun',    # CAP::Baz

	'prerun/CGI::Application::Plugin::Baz::baz_prerun',    # CAP::Bam

	'baz_hook/CGI::Application::Plugin::Baz::baz_custom',  # CAP::Bam


	'prerun/Other::App::cgiapp_prerun',                    # Other::App (but installed via CGI::Application)


	# Run mode
	'runmode/Other::App::begin',                           # Other::App

	# postrun
	'postrun/Other::App::other_app_postrun',               # Other::App (but installed in object)

	'postrun/CGI::Application::Plugin::Bam::bam_postrun',  # CAP::Bam
	'bam_hook/CGI::Application::Plugin::Bam::bam_custom',  # CAP::Bam


	'postrun/CGI::Application::Plugin::Baz::baz_postrun',  # CAP::Baz
	'postrun/Other::App::cgiapp_postrun',                  # Other::App (but installed via CGI::Application)

	# teardown
	'teardown/CGI::Application::Plugin::Bam::bam_teardown',  # CAP::Bam
	'teardown/CGI::Application::Plugin::Baz::baz_teardown',  # CAP::Baz
	'teardown/Other::App::teardown',                         # Other::App (but installed via CGI::Application)

);

is_deeply(\@Event_History, \@expected_events, 'Other::App - callbacks executed correctly')
   or do {
		use	Data::Dumper;
		print STDERR "Actual Event History: \n";
		print STDERR Dumper	\@Event_History;
};


@Event_History = ();
Unrelated::App->new->run;

@expected_events = (
	# init

	'init/Unrelated::App::cgiapp_init',                    # Unrelated::App (but installed via CGI::Application)

	'init/My::Project::my_project_global_init',            # My::Project (rudely) registered a callback in the
														   # CGI::Application class, which forces us to	run	it

	'init/Other::Project::other_project_global_init',      # Unrelated::Project (rudely) registered a callback in the
														   # CGI::Application class, which forces us to	run	it


	# prerun

	'prerun/Unrelated::App::cgiapp_prerun',                # Unrelated::App (but installed via CGI::Application)


	# Run mode
	'runmode/Unrelated::App::begin',                       # Unrelated::App

	# postrun
	'postrun/Unrelated::App::cgiapp_postrun',              # Unrelated::App (but installed via CGI::Application)

	# teardown
	'teardown/Unrelated::App::teardown',                   # Unrelated::App (but installed via CGI::Application)

);

is_deeply(\@Event_History, \@expected_events, 'Unrelated::App - callbacks executed correctly')
   or do {
		use	Data::Dumper;
		print STDERR "Actual Event History: \n";
		print STDERR Dumper	\@Event_History;
};