Commit 29f5171ec584bc17e254e396799e9715a0105a91 - libmoosex-daemonize-perl

+0

-0

.cvsignore less more

(New empty file)

+1

-0

.git/COMMIT_EDITMSG less more

0

clean stuff up for a 0.09 release

+1

-0

.git/HEAD less more

0

ref: refs/heads/master

+12

-0

.git/config less more

	0	[core]
	1	repositoryformatversion = 0
	2	filemode = true
	3	bare = false
	4	logallrefupdates = true
	5	ignorecase = true
	6	[remote "origin"]
	7	fetch = +refs/heads/:refs/remotes/origin/
	8	url = gitmo@git.moose.perl.org:MooseX-Daemonize.git
	9	[branch "master"]
	10	remote = origin
	11	merge = refs/heads/master

+1

-0

.git/description less more

0

Unnamed repository; edit this file 'description' to name the repository.

+15

-0

.git/hooks/applypatch-msg less more

	0	#!/bin/sh
	1	#
	2	# An example hook script to check the commit log message taken by
	3	# applypatch from an e-mail message.
	4	#
	5	# The hook should exit with non-zero status after issuing an
	6	# appropriate message if it wants to stop the commit. The hook is
	7	# allowed to edit the commit message file.
	8	#
	9	# To enable this hook, make this file executable.
	10
	11	. git-sh-setup
	12	test -x "$GIT_DIR/hooks/commit-msg" &&
	13	exec "$GIT_DIR/hooks/commit-msg" ${1+"$@"}
	14	:

+15

-0

.git/hooks/applypatch-msg.sample less more

	0	#!/bin/sh
	1	#
	2	# An example hook script to check the commit log message taken by
	3	# applypatch from an e-mail message.
	4	#
	5	# The hook should exit with non-zero status after issuing an
	6	# appropriate message if it wants to stop the commit. The hook is
	7	# allowed to edit the commit message file.
	8	#
	9	# To enable this hook, rename this file to "applypatch-msg".
	10
	11	. git-sh-setup
	12	test -x "$GIT_DIR/hooks/commit-msg" &&
	13	exec "$GIT_DIR/hooks/commit-msg" ${1+"$@"}
	14	:

+24

-0

.git/hooks/commit-msg less more

	0	#!/bin/sh
	1	#
	2	# An example hook script to check the commit log message.
	3	# Called by git-commit with one argument, the name of the file
	4	# that has the commit message. The hook should exit with non-zero
	5	# status after issuing an appropriate message if it wants to stop the
	6	# commit. The hook is allowed to edit the commit message file.
	7	#
	8	# To enable this hook, make this file executable.
	9
	10	# Uncomment the below to add a Signed-off-by line to the message.
	11	# Doing this in a hook is a bad idea in general, but the prepare-commit-msg
	12	# hook is more suited to it.
	13	#
	14	# SOB=$(git var GIT_AUTHOR_IDENT \| sed -n 's/^$.>$.$/Signed-off-by: \1/p')
	15	# grep -qs "^$SOB" "$1" \|\| echo "$SOB" >> "$1"
	16
	17	# This example catches duplicate Signed-off-by lines.
	18
	19	test "" = "$(grep '^Signed-off-by: ' "$1" \|
	20	sort \| uniq -c \| sed -e '/^[ ]*1[ ]/d')" \|\| {
	21	echo >&2 Duplicate Signed-off-by lines.
	22	exit 1
	23	}

+24

-0

.git/hooks/commit-msg.sample less more

	0	#!/bin/sh
	1	#
	2	# An example hook script to check the commit log message.
	3	# Called by git-commit with one argument, the name of the file
	4	# that has the commit message. The hook should exit with non-zero
	5	# status after issuing an appropriate message if it wants to stop the
	6	# commit. The hook is allowed to edit the commit message file.
	7	#
	8	# To enable this hook, rename this file to "commit-msg".
	9
	10	# Uncomment the below to add a Signed-off-by line to the message.
	11	# Doing this in a hook is a bad idea in general, but the prepare-commit-msg
	12	# hook is more suited to it.
	13	#
	14	# SOB=$(git var GIT_AUTHOR_IDENT \| sed -n 's/^$.>$.$/Signed-off-by: \1/p')
	15	# grep -qs "^$SOB" "$1" \|\| echo "$SOB" >> "$1"
	16
	17	# This example catches duplicate Signed-off-by lines.
	18
	19	test "" = "$(grep '^Signed-off-by: ' "$1" \|
	20	sort \| uniq -c \| sed -e '/^[ ]*1[ ]/d')" \|\| {
	21	echo >&2 Duplicate Signed-off-by lines.
	22	exit 1
	23	}

+8

-0

.git/hooks/post-commit less more

	0	#!/bin/sh
	1	#
	2	# An example hook script that is called after a successful
	3	# commit is made.
	4	#
	5	# To enable this hook, make this file executable.
	6
	7	: Nothing

+8

-0

.git/hooks/post-commit.sample less more

	0	#!/bin/sh
	1	#
	2	# An example hook script that is called after a successful
	3	# commit is made.
	4	#
	5	# To enable this hook, rename this file to "post-commit".
	6
	7	: Nothing

+16

-0

.git/hooks/post-receive less more

	0	#!/bin/sh
	1	#
	2	# An example hook script for the post-receive event
	3	#
	4	# This script is run after receive-pack has accepted a pack and the
	5	# repository has been updated. It is passed arguments in through stdin
	6	# in the form
	7	# <oldrev> <newrev> <refname>
	8	# For example:
	9	# aa453216d1b3e49e7f6f98441fa56946ddcd6a20 68f7abf4e6f922807889f52bc043ecd31b79f814 refs/heads/master
	10	#
	11	# see contrib/hooks/ for an sample, or uncomment the next line (on debian)
	12	#
	13
	14
	15	#. /usr/share/doc/git-core/contrib/hooks/post-receive-email

+15

-0

.git/hooks/post-receive.sample less more

	0	#!/bin/sh
	1	#
	2	# An example hook script for the "post-receive" event.
	3	#
	4	# The "post-receive" script is run after receive-pack has accepted a pack
	5	# and the repository has been updated. It is passed arguments in through
	6	# stdin in the form
	7	# <oldrev> <newrev> <refname>
	8	# For example:
	9	# aa453216d1b3e49e7f6f98441fa56946ddcd6a20 68f7abf4e6f922807889f52bc043ecd31b79f814 refs/heads/master
	10	#
	11	# see contrib/hooks/ for an sample, or uncomment the next line and
	12	# rename the file to "post-receive".
	13
	14	#. /usr/share/doc/git-core/contrib/hooks/post-receive-email

+8

-0

.git/hooks/post-update less more

	0	#!/bin/sh
	1	#
	2	# An example hook script to prepare a packed repository for use over
	3	# dumb transports.
	4	#
	5	# To enable this hook, make this file executable by "chmod +x post-update".
	6
	7	exec git-update-server-info

+8

-0

.git/hooks/post-update.sample less more

	0	#!/bin/sh
	1	#
	2	# An example hook script to prepare a packed repository for use over
	3	# dumb transports.
	4	#
	5	# To enable this hook, rename this file to "post-update".
	6
	7	exec git-update-server-info

+14

-0

.git/hooks/pre-applypatch less more

	0	#!/bin/sh
	1	#
	2	# An example hook script to verify what is about to be committed
	3	# by applypatch from an e-mail message.
	4	#
	5	# The hook should exit with non-zero status after issuing an
	6	# appropriate message if it wants to stop the commit.
	7	#
	8	# To enable this hook, make this file executable.
	9
	10	. git-sh-setup
	11	test -x "$GIT_DIR/hooks/pre-commit" &&
	12	exec "$GIT_DIR/hooks/pre-commit" ${1+"$@"}
	13	:

+14

-0

.git/hooks/pre-applypatch.sample less more

	0	#!/bin/sh
	1	#
	2	# An example hook script to verify what is about to be committed
	3	# by applypatch from an e-mail message.
	4	#
	5	# The hook should exit with non-zero status after issuing an
	6	# appropriate message if it wants to stop the commit.
	7	#
	8	# To enable this hook, rename this file to "pre-applypatch".
	9
	10	. git-sh-setup
	11	test -x "$GIT_DIR/hooks/pre-commit" &&
	12	exec "$GIT_DIR/hooks/pre-commit" ${1+"$@"}
	13	:

+70

-0

.git/hooks/pre-commit less more

	0	#!/bin/sh
	1	#
	2	# An example hook script to verify what is about to be committed.
	3	# Called by git-commit with no arguments. The hook should
	4	# exit with non-zero status after issuing an appropriate message if
	5	# it wants to stop the commit.
	6	#
	7	# To enable this hook, make this file executable.
	8
	9	# This is slightly modified from Andrew Morton's Perfect Patch.
	10	# Lines you introduce should not have trailing whitespace.
	11	# Also check for an indentation that has SP before a TAB.
	12
	13	if git-rev-parse --verify HEAD 2>/dev/null
	14	then
	15	git-diff-index -p -M --cached HEAD --
	16	else
	17	# NEEDSWORK: we should produce a diff with an empty tree here
	18	# if we want to do the same verification for the initial import.
	19	:
	20	fi \|
	21	perl -e '
	22	my $found_bad = 0;
	23	my $filename;
	24	my $reported_filename = "";
	25	my $lineno;
	26	sub bad_line {
	27	my ($why, $line) = @_;
	28	if (!$found_bad) {
	29	print STDERR "*\n";
	30	print STDERR "* You have some suspicious patch lines:\n";
	31	print STDERR "*\n";
	32	$found_bad = 1;
	33	}
	34	if ($reported_filename ne $filename) {
	35	print STDERR "* In $filename\n";
	36	$reported_filename = $filename;
	37	}
	38	print STDERR "* $why (line $lineno)\n";
	39	print STDERR "$filename:$lineno:$line\n";
	40	}
	41	while (<>) {
	42	if (m\|^diff --git a/(.*) b/\1$\|) {
	43	$filename = $1;
	44	next;
	45	}
	46	if (/^@@ -\S+ \+(\d+)/) {
	47	$lineno = $1 - 1;
	48	next;
	49	}
	50	if (/^ /) {
	51	$lineno++;
	52	next;
	53	}
	54	if (s/^\+//) {
	55	$lineno++;
	56	chomp;
	57	if (/\s$/) {
	58	bad_line("trailing whitespace", $_);
	59	}
	60	if (/^\s* \t/) {
	61	bad_line("indent SP followed by a TAB", $_);
	62	}
	63	if (/^([<>])\1{6} \|^={7}$/) {
	64	bad_line("unresolved merge conflict", $_);
	65	}
	66	}
	67	}
	68	exit($found_bad);
	69	'

+43

-0

.git/hooks/pre-commit.sample less more

	0	#!/bin/sh
	1	#
	2	# An example hook script to verify what is about to be committed.
	3	# Called by git-commit with no arguments. The hook should
	4	# exit with non-zero status after issuing an appropriate message if
	5	# it wants to stop the commit.
	6	#
	7	# To enable this hook, rename this file to "pre-commit".
	8
	9	# If you want to allow non-ascii filenames set this variable to true.
	10	allownonascii=$(git config hooks.allownonascii)
	11
	12	# Cross platform projects tend to avoid non-ascii filenames; prevent
	13	# them from being added to the repository. We exploit the fact that the
	14	# printable range starts at the space character and ends with tilde.
	15	if [ "$allownonascii" != "true" ] &&
	16	test "$(git diff --cached --name-only --diff-filter=A -z \|
	17	LC_ALL=C tr -d '[ -~]\0')"
	18	then
	19	echo "Error: Attempt to add a non-ascii filename."
	20	echo
	21	echo "This can cause problems if you want to work together"
	22	echo "with people on other platforms than you."
	23	echo
	24	echo "To be portable it is adviseable to rename the file ..."
	25	echo
	26	echo "If you know what you are doing you can disable this"
	27	echo "check using:"
	28	echo
	29	echo " git config hooks.allownonascii true"
	30	echo
	31	exit 1
	32	fi
	33
	34	if git-rev-parse --verify HEAD >/dev/null 2>&1
	35	then
	36	against=HEAD
	37	else
	38	# Initial commit: diff against an empty tree object
	39	against=4b825dc642cb6eb9a060e54bf8d69288fbee4904
	40	fi
	41
	42	exec git diff-index --check --cached $against --

+150

-0

.git/hooks/pre-rebase less more

	0	#!/bin/sh
	1	#
	2	# Copyright (c) 2006 Junio C Hamano
	3	#
	4
	5	publish=next
	6	basebranch="$1"
	7	if test "$#" = 2
	8	then
	9	topic="refs/heads/$2"
	10	else
	11	topic=`git symbolic-ref HEAD`
	12	fi
	13
	14	case "$basebranch,$topic" in
	15	master,refs/heads/??/*)
	16	;;
	17	*)
	18	exit 0 ;# we do not interrupt others.
	19	;;
	20	esac
	21
	22	# Now we are dealing with a topic branch being rebased
	23	# on top of master. Is it OK to rebase it?
	24
	25	# Is topic fully merged to master?
	26	not_in_master=`git-rev-list --pretty=oneline ^master "$topic"`
	27	if test -z "$not_in_master"
	28	then
	29	echo >&2 "$topic is fully merged to master; better remove it."
	30	exit 1 ;# we could allow it, but there is no point.
	31	fi
	32
	33	# Is topic ever merged to next? If so you should not be rebasing it.
	34	only_next_1=`git-rev-list ^master "^$topic" ${publish} \| sort`
	35	only_next_2=`git-rev-list ^master ${publish} \| sort`
	36	if test "$only_next_1" = "$only_next_2"
	37	then
	38	not_in_topic=`git-rev-list "^$topic" master`
	39	if test -z "$not_in_topic"
	40	then
	41	echo >&2 "$topic is already up-to-date with master"
	42	exit 1 ;# we could allow it, but there is no point.
	43	else
	44	exit 0
	45	fi
	46	else
	47	not_in_next=`git-rev-list --pretty=oneline ^${publish} "$topic"`
	48	perl -e '
	49	my $topic = $ARGV[0];
	50	my $msg = "* $topic has commits already merged to public branch:\n";
	51	my (%not_in_next) = map {
	52	/^([0-9a-f]+) /;
	53	($1 => 1);
	54	} split(/\n/, $ARGV[1]);
	55	for my $elem (map {
	56	/^([0-9a-f]+) (.*)$/;
	57	[$1 => $2];
	58	} split(/\n/, $ARGV[2])) {
	59	if (!exists $not_in_next{$elem->[0]}) {
	60	if ($msg) {
	61	print STDERR $msg;
	62	undef $msg;
	63	}
	64	print STDERR " $elem->[1]\n";
	65	}
	66	}
	67	' "$topic" "$not_in_next" "$not_in_master"
	68	exit 1
	69	fi
	70
	71	exit 0
	72
	73	################################################################
	74
	75	This sample hook safeguards topic branches that have been
	76	published from being rewound.
	77
	78	The workflow assumed here is:
	79
	80	* Once a topic branch forks from "master", "master" is never
	81	merged into it again (either directly or indirectly).
	82
	83	* Once a topic branch is fully cooked and merged into "master",
	84	it is deleted. If you need to build on top of it to correct
	85	earlier mistakes, a new topic branch is created by forking at
	86	the tip of the "master". This is not strictly necessary, but
	87	it makes it easier to keep your history simple.
	88
	89	* Whenever you need to test or publish your changes to topic
	90	branches, merge them into "next" branch.
	91
	92	The script, being an example, hardcodes the publish branch name
	93	to be "next", but it is trivial to make it configurable via
	94	$GIT_DIR/config mechanism.
	95
	96	With this workflow, you would want to know:
	97
	98	(1) ... if a topic branch has ever been merged to "next". Young
	99	topic branches can have stupid mistakes you would rather
	100	clean up before publishing, and things that have not been
	101	merged into other branches can be easily rebased without
	102	affecting other people. But once it is published, you would
	103	not want to rewind it.
	104
	105	(2) ... if a topic branch has been fully merged to "master".
	106	Then you can delete it. More importantly, you should not
	107	build on top of it -- other people may already want to
	108	change things related to the topic as patches against your
	109	"master", so if you need further changes, it is better to
	110	fork the topic (perhaps with the same name) afresh from the
	111	tip of "master".
	112
	113	Let's look at this example:
	114
	115	o---o---o---o---o---o---o---o---o---o "next"
	116	/ / / /
	117	/ a---a---b A / /
	118	/ / / /
	119	/ / c---c---c---c B /
	120	/ / / \ /
	121	/ / / b---b C \ /
	122	/ / / / \ /
	123	---o---o---o---o---o---o---o---o---o---o---o "master"
	124
	125
	126	A, B and C are topic branches.
	127
	128	* A has one fix since it was merged up to "next".
	129
	130	* B has finished. It has been fully merged up to "master" and "next",
	131	and is ready to be deleted.
	132
	133	* C has not merged to "next" at all.
	134
	135	We would want to allow C to be rebased, refuse A, and encourage
	136	B to be deleted.
	137
	138	To compute (1):
	139
	140	git-rev-list ^master ^topic next
	141	git-rev-list ^master next
	142
	143	if these match, topic has not merged in next at all.
	144
	145	To compute (2):
	146
	147	git-rev-list master..topic
	148
	149	if this is empty, it is fully merged to "master".

+169

-0

.git/hooks/pre-rebase.sample less more

	0	#!/bin/sh
	1	#
	2	# Copyright (c) 2006, 2008 Junio C Hamano
	3	#
	4	# The "pre-rebase" hook is run just before "git-rebase" starts doing
	5	# its job, and can prevent the command from running by exiting with
	6	# non-zero status.
	7	#
	8	# The hook is called with the following parameters:
	9	#
	10	# $1 -- the upstream the series was forked from.
	11	# $2 -- the branch being rebased (or empty when rebasing the current branch).
	12	#
	13	# This sample shows how to prevent topic branches that are already
	14	# merged to 'next' branch from getting rebased, because allowing it
	15	# would result in rebasing already published history.
	16
	17	publish=next
	18	basebranch="$1"
	19	if test "$#" = 2
	20	then
	21	topic="refs/heads/$2"
	22	else
	23	topic=`git symbolic-ref HEAD` \|\|
	24	exit 0 ;# we do not interrupt rebasing detached HEAD
	25	fi
	26
	27	case "$topic" in
	28	refs/heads/??/*)
	29	;;
	30	*)
	31	exit 0 ;# we do not interrupt others.
	32	;;
	33	esac
	34
	35	# Now we are dealing with a topic branch being rebased
	36	# on top of master. Is it OK to rebase it?
	37
	38	# Does the topic really exist?
	39	git show-ref -q "$topic" \|\| {
	40	echo >&2 "No such branch $topic"
	41	exit 1
	42	}
	43
	44	# Is topic fully merged to master?
	45	not_in_master=`git-rev-list --pretty=oneline ^master "$topic"`
	46	if test -z "$not_in_master"
	47	then
	48	echo >&2 "$topic is fully merged to master; better remove it."
	49	exit 1 ;# we could allow it, but there is no point.
	50	fi
	51
	52	# Is topic ever merged to next? If so you should not be rebasing it.
	53	only_next_1=`git-rev-list ^master "^$topic" ${publish} \| sort`
	54	only_next_2=`git-rev-list ^master ${publish} \| sort`
	55	if test "$only_next_1" = "$only_next_2"
	56	then
	57	not_in_topic=`git-rev-list "^$topic" master`
	58	if test -z "$not_in_topic"
	59	then
	60	echo >&2 "$topic is already up-to-date with master"
	61	exit 1 ;# we could allow it, but there is no point.
	62	else
	63	exit 0
	64	fi
	65	else
	66	not_in_next=`git-rev-list --pretty=oneline ^${publish} "$topic"`
	67	perl -e '
	68	my $topic = $ARGV[0];
	69	my $msg = "* $topic has commits already merged to public branch:\n";
	70	my (%not_in_next) = map {
	71	/^([0-9a-f]+) /;
	72	($1 => 1);
	73	} split(/\n/, $ARGV[1]);
	74	for my $elem (map {
	75	/^([0-9a-f]+) (.*)$/;
	76	[$1 => $2];
	77	} split(/\n/, $ARGV[2])) {
	78	if (!exists $not_in_next{$elem->[0]}) {
	79	if ($msg) {
	80	print STDERR $msg;
	81	undef $msg;
	82	}
	83	print STDERR " $elem->[1]\n";
	84	}
	85	}
	86	' "$topic" "$not_in_next" "$not_in_master"
	87	exit 1
	88	fi
	89
	90	exit 0
	91
	92	################################################################
	93
	94	This sample hook safeguards topic branches that have been
	95	published from being rewound.
	96
	97	The workflow assumed here is:
	98
	99	* Once a topic branch forks from "master", "master" is never
	100	merged into it again (either directly or indirectly).
	101
	102	* Once a topic branch is fully cooked and merged into "master",
	103	it is deleted. If you need to build on top of it to correct
	104	earlier mistakes, a new topic branch is created by forking at
	105	the tip of the "master". This is not strictly necessary, but
	106	it makes it easier to keep your history simple.
	107
	108	* Whenever you need to test or publish your changes to topic
	109	branches, merge them into "next" branch.
	110
	111	The script, being an example, hardcodes the publish branch name
	112	to be "next", but it is trivial to make it configurable via
	113	$GIT_DIR/config mechanism.
	114
	115	With this workflow, you would want to know:
	116
	117	(1) ... if a topic branch has ever been merged to "next". Young
	118	topic branches can have stupid mistakes you would rather
	119	clean up before publishing, and things that have not been
	120	merged into other branches can be easily rebased without
	121	affecting other people. But once it is published, you would
	122	not want to rewind it.
	123
	124	(2) ... if a topic branch has been fully merged to "master".
	125	Then you can delete it. More importantly, you should not
	126	build on top of it -- other people may already want to
	127	change things related to the topic as patches against your
	128	"master", so if you need further changes, it is better to
	129	fork the topic (perhaps with the same name) afresh from the
	130	tip of "master".
	131
	132	Let's look at this example:
	133
	134	o---o---o---o---o---o---o---o---o---o "next"
	135	/ / / /
	136	/ a---a---b A / /
	137	/ / / /
	138	/ / c---c---c---c B /
	139	/ / / \ /
	140	/ / / b---b C \ /
	141	/ / / / \ /
	142	---o---o---o---o---o---o---o---o---o---o---o "master"
	143
	144
	145	A, B and C are topic branches.
	146
	147	* A has one fix since it was merged up to "next".
	148
	149	* B has finished. It has been fully merged up to "master" and "next",
	150	and is ready to be deleted.
	151
	152	* C has not merged to "next" at all.
	153
	154	We would want to allow C to be rebased, refuse A, and encourage
	155	B to be deleted.
	156
	157	To compute (1):
	158
	159	git-rev-list ^master ^topic next
	160	git-rev-list ^master next
	161
	162	if these match, topic has not merged in next at all.
	163
	164	To compute (2):
	165
	166	git-rev-list master..topic
	167
	168	if this is empty, it is fully merged to "master".

+36

-0

.git/hooks/prepare-commit-msg less more

	0	#!/bin/sh
	1	#
	2	# An example hook script to prepare the commit log message.
	3	# Called by git-commit with the name of the file that has the
	4	# commit message, followed by the description of the commit
	5	# message's source. The hook's purpose is to edit the commit
	6	# message file. If the hook fails with a non-zero status,
	7	# the commit is aborted.
	8	#
	9	# To enable this hook, make this file executable.
	10
	11	# This hook includes three examples. The first comments out the
	12	# "Conflicts:" part of a merge commit.
	13	#
	14	# The second includes the output of "git diff --name-status -r"
	15	# into the message, just before the "git status" output. It is
	16	# commented because it doesn't cope with --amend or with squashed
	17	# commits.
	18	#
	19	# The third example adds a Signed-off-by line to the message, that can
	20	# still be edited. This is rarely a good idea.
	21
	22	case "$2 $3" in
	23	merge)
	24	sed -i '/^Conflicts:/,/#/!b;s/^/# &/;s/^# #/#/' "$1" ;;
	25
	26	# ""\|template)
	27	# perl -i -pe '
	28	# print "\n" . `git diff --cached --name-status -r`
	29	# if /^#/ && $first++ == 0' "$1" ;;
	30
	31	*) ;;
	32	esac
	33
	34	# SOB=$(git var GIT_AUTHOR_IDENT \| sed -n 's/^$.>$.$/Signed-off-by: \1/p')
	35	# grep -qs "^$SOB" "$1" \|\| echo "$SOB" >> "$1"

+36

-0

.git/hooks/prepare-commit-msg.sample less more

	0	#!/bin/sh
	1	#
	2	# An example hook script to prepare the commit log message.
	3	# Called by git-commit with the name of the file that has the
	4	# commit message, followed by the description of the commit
	5	# message's source. The hook's purpose is to edit the commit
	6	# message file. If the hook fails with a non-zero status,
	7	# the commit is aborted.
	8	#
	9	# To enable this hook, rename this file to "prepare-commit-msg".
	10
	11	# This hook includes three examples. The first comments out the
	12	# "Conflicts:" part of a merge commit.
	13	#
	14	# The second includes the output of "git diff --name-status -r"
	15	# into the message, just before the "git status" output. It is
	16	# commented because it doesn't cope with --amend or with squashed
	17	# commits.
	18	#
	19	# The third example adds a Signed-off-by line to the message, that can
	20	# still be edited. This is rarely a good idea.
	21
	22	case "$2,$3" in
	23	merge,)
	24	perl -i.bak -ne 's/^/# /, s/^# #/#/ if /^Conflicts/ .. /#/; print' "$1" ;;
	25
	26	# ,\|template,)
	27	# perl -i.bak -pe '
	28	# print "\n" . `git diff --cached --name-status -r`
	29	# if /^#/ && $first++ == 0' "$1" ;;
	30
	31	*) ;;
	32	esac
	33
	34	# SOB=$(git var GIT_AUTHOR_IDENT \| sed -n 's/^$.>$.$/Signed-off-by: \1/p')
	35	# grep -qs "^$SOB" "$1" \|\| echo "$SOB" >> "$1"

+107

-0

.git/hooks/update less more

	0	#!/bin/sh
	1	#
	2	# An example hook script to blocks unannotated tags from entering.
	3	# Called by git-receive-pack with arguments: refname sha1-old sha1-new
	4	#
	5	# To enable this hook, make this file executable by "chmod +x update".
	6	#
	7	# Config
	8	# ------
	9	# hooks.allowunannotated
	10	# This boolean sets whether unannotated tags will be allowed into the
	11	# repository. By default they won't be.
	12	# hooks.allowdeletetag
	13	# This boolean sets whether deleting tags will be allowed in the
	14	# repository. By default they won't be.
	15	# hooks.allowdeletebranch
	16	# This boolean sets whether deleting branches will be allowed in the
	17	# repository. By default they won't be.
	18	#
	19
	20	# --- Command line
	21	refname="$1"
	22	oldrev="$2"
	23	newrev="$3"
	24
	25	# --- Safety check
	26	if [ -z "$GIT_DIR" ]; then
	27	echo "Don't run this script from the command line." >&2
	28	echo " (if you want, you could supply GIT_DIR then run" >&2
	29	echo " $0 <ref> <oldrev> <newrev>)" >&2
	30	exit 1
	31	fi
	32
	33	if [ -z "$refname" -o -z "$oldrev" -o -z "$newrev" ]; then
	34	echo "Usage: $0 <ref> <oldrev> <newrev>" >&2
	35	exit 1
	36	fi
	37
	38	# --- Config
	39	allowunannotated=$(git config --bool hooks.allowunannotated)
	40	allowdeletebranch=$(git config --bool hooks.allowdeletebranch)
	41	allowdeletetag=$(git config --bool hooks.allowdeletetag)
	42
	43	# check for no description
	44	projectdesc=$(sed -e '1q' "$GIT_DIR/description")
	45	if [ -z "$projectdesc" -o "$projectdesc" = "Unnamed repository; edit this file to name it for gitweb." ]; then
	46	echo "*** Project description file hasn't been set" >&2
	47	exit 1
	48	fi
	49
	50	# --- Check types
	51	# if $newrev is 0000...0000, it's a commit to delete a ref.
	52	if [ "$newrev" = "0000000000000000000000000000000000000000" ]; then
	53	newrev_type=delete
	54	else
	55	newrev_type=$(git-cat-file -t $newrev)
	56	fi
	57
	58	case "$refname","$newrev_type" in
	59	refs/tags/*,commit)
	60	# un-annotated tag
	61	short_refname=${refname##refs/tags/}
	62	if [ "$allowunannotated" != "true" ]; then
	63	echo "*** The un-annotated tag, $short_refname, is not allowed in this repository" >&2
	64	echo "*** Use 'git tag [ -a \| -s ]' for tags you want to propagate." >&2
	65	exit 1
	66	fi
	67	;;
	68	refs/tags/*,delete)
	69	# delete tag
	70	if [ "$allowdeletetag" != "true" ]; then
	71	echo "*** Deleting a tag is not allowed in this repository" >&2
	72	exit 1
	73	fi
	74	;;
	75	refs/tags/*,tag)
	76	# annotated tag
	77	;;
	78	refs/heads/*,commit)
	79	# branch
	80	;;
	81	refs/heads/*,delete)
	82	# delete branch
	83	if [ "$allowdeletebranch" != "true" ]; then
	84	echo "*** Deleting a branch is not allowed in this repository" >&2
	85	exit 1
	86	fi
	87	;;
	88	refs/remotes/*,commit)
	89	# tracking branch
	90	;;
	91	refs/remotes/*,delete)
	92	# delete tracking branch
	93	if [ "$allowdeletebranch" != "true" ]; then
	94	echo "*** Deleting a tracking branch is not allowed in this repository" >&2
	95	exit 1
	96	fi
	97	;;
	98	*)
	99	# Anything else (is there anything else?)
	100	echo "*** Update hook: unknown type of update to ref $refname of type $newrev_type" >&2
	101	exit 1
	102	;;
	103	esac
	104
	105	# --- Finished
	106	exit 0

+128

-0

.git/hooks/update.sample less more

	0	#!/bin/sh
	1	#
	2	# An example hook script to blocks unannotated tags from entering.
	3	# Called by git-receive-pack with arguments: refname sha1-old sha1-new
	4	#
	5	# To enable this hook, rename this file to "update".
	6	#
	7	# Config
	8	# ------
	9	# hooks.allowunannotated
	10	# This boolean sets whether unannotated tags will be allowed into the
	11	# repository. By default they won't be.
	12	# hooks.allowdeletetag
	13	# This boolean sets whether deleting tags will be allowed in the
	14	# repository. By default they won't be.
	15	# hooks.allowmodifytag
	16	# This boolean sets whether a tag may be modified after creation. By default
	17	# it won't be.
	18	# hooks.allowdeletebranch
	19	# This boolean sets whether deleting branches will be allowed in the
	20	# repository. By default they won't be.
	21	# hooks.denycreatebranch
	22	# This boolean sets whether remotely creating branches will be denied
	23	# in the repository. By default this is allowed.
	24	#
	25
	26	# --- Command line
	27	refname="$1"
	28	oldrev="$2"
	29	newrev="$3"
	30
	31	# --- Safety check
	32	if [ -z "$GIT_DIR" ]; then
	33	echo "Don't run this script from the command line." >&2
	34	echo " (if you want, you could supply GIT_DIR then run" >&2
	35	echo " $0 <ref> <oldrev> <newrev>)" >&2
	36	exit 1
	37	fi
	38
	39	if [ -z "$refname" -o -z "$oldrev" -o -z "$newrev" ]; then
	40	echo "Usage: $0 <ref> <oldrev> <newrev>" >&2
	41	exit 1
	42	fi
	43
	44	# --- Config
	45	allowunannotated=$(git config --bool hooks.allowunannotated)
	46	allowdeletebranch=$(git config --bool hooks.allowdeletebranch)
	47	denycreatebranch=$(git config --bool hooks.denycreatebranch)
	48	allowdeletetag=$(git config --bool hooks.allowdeletetag)
	49	allowmodifytag=$(git config --bool hooks.allowmodifytag)
	50
	51	# check for no description
	52	projectdesc=$(sed -e '1q' "$GIT_DIR/description")
	53	case "$projectdesc" in
	54	"Unnamed repository"* \| "")
	55	echo "*** Project description file hasn't been set" >&2
	56	exit 1
	57	;;
	58	esac
	59
	60	# --- Check types
	61	# if $newrev is 0000...0000, it's a commit to delete a ref.
	62	zero="0000000000000000000000000000000000000000"
	63	if [ "$newrev" = "$zero" ]; then
	64	newrev_type=delete
	65	else
	66	newrev_type=$(git-cat-file -t $newrev)
	67	fi
	68
	69	case "$refname","$newrev_type" in
	70	refs/tags/*,commit)
	71	# un-annotated tag
	72	short_refname=${refname##refs/tags/}
	73	if [ "$allowunannotated" != "true" ]; then
	74	echo "*** The un-annotated tag, $short_refname, is not allowed in this repository" >&2
	75	echo "*** Use 'git tag [ -a \| -s ]' for tags you want to propagate." >&2
	76	exit 1
	77	fi
	78	;;
	79	refs/tags/*,delete)
	80	# delete tag
	81	if [ "$allowdeletetag" != "true" ]; then
	82	echo "*** Deleting a tag is not allowed in this repository" >&2
	83	exit 1
	84	fi
	85	;;
	86	refs/tags/*,tag)
	87	# annotated tag
	88	if [ "$allowmodifytag" != "true" ] && git rev-parse $refname > /dev/null 2>&1
	89	then
	90	echo "*** Tag '$refname' already exists." >&2
	91	echo "*** Modifying a tag is not allowed in this repository." >&2
	92	exit 1
	93	fi
	94	;;
	95	refs/heads/*,commit)
	96	# branch
	97	if [ "$oldrev" = "$zero" -a "$denycreatebranch" = "true" ]; then
	98	echo "*** Creating a branch is not allowed in this repository" >&2
	99	exit 1
	100	fi
	101	;;
	102	refs/heads/*,delete)
	103	# delete branch
	104	if [ "$allowdeletebranch" != "true" ]; then
	105	echo "*** Deleting a branch is not allowed in this repository" >&2
	106	exit 1
	107	fi
	108	;;
	109	refs/remotes/*,commit)
	110	# tracking branch
	111	;;
	112	refs/remotes/*,delete)
	113	# delete tracking branch
	114	if [ "$allowdeletebranch" != "true" ]; then
	115	echo "*** Deleting a tracking branch is not allowed in this repository" >&2
	116	exit 1
	117	fi
	118	;;
	119	*)
	120	# Anything else (is there anything else?)
	121	echo "*** Update hook: unknown type of update to ref $refname of type $newrev_type" >&2
	122	exit 1
	123	;;
	124	esac
	125
	126	# --- Finished
	127	exit 0

.git/index less more

Binary diff not shown

+6

-0

.git/info/exclude less more

	0	# git-ls-files --others --exclude-from=.git/info/exclude
	1	# Lines that start with '#' are comments.
	2	# For a project mostly in C, the following would be a good set of
	3	# exclude patterns (uncomment them if you want to use them):
	4	# *.[oa]
	5	# *~

+2

-0

.git/logs/HEAD less more

	0	0000000000000000000000000000000000000000 10769ed347f340ee0e81d85933ae8f82ff0413da Chris Prather <chris@prather.org> 1254769903 -0400 clone: from gitmo@git.moose.perl.org:MooseX-Daemonize.git
	1	10769ed347f340ee0e81d85933ae8f82ff0413da 69186a4879a2ddfed228c03e7a25d5455921dfb0 Chris Prather <chris@prather.org> 1254770500 -0400 commit: clean stuff up for a 0.09 release

+2

-0

.git/logs/refs/heads/master less more

	0	0000000000000000000000000000000000000000 10769ed347f340ee0e81d85933ae8f82ff0413da Chris Prather <chris@prather.org> 1254769903 -0400 clone: from gitmo@git.moose.perl.org:MooseX-Daemonize.git
	1	10769ed347f340ee0e81d85933ae8f82ff0413da 69186a4879a2ddfed228c03e7a25d5455921dfb0 Chris Prather <chris@prather.org> 1254770500 -0400 commit: clean stuff up for a 0.09 release

+1

-0

.git/logs/refs/remotes/origin/HEAD less more

0

0000000000000000000000000000000000000000 10769ed347f340ee0e81d85933ae8f82ff0413da Chris Prather <chris@prather.org> 1254769903 -0400 clone: from gitmo@git.moose.perl.org:MooseX-Daemonize.git

.git/objects/03/30a27f596ae6a5b60e54cdef23a6e4dcefeaf3 less more

Binary diff not shown

.git/objects/1f/070dff6004310ba11c3525f1ac8508c69ab8a5 less more

Binary diff not shown

.git/objects/28/41cd7f04dbb7c8cd04c0c5fa64c939b9393615 less more

Binary diff not shown

.git/objects/33/aa69e3767ca7dfaeaa92119695b796e06f1bd4 less more

Binary diff not shown

+3

-0

.git/objects/69/186a4879a2ddfed228c03e7a25d5455921dfb0 less more

	0	x[
	1	Â0EýÎ*fÊÍ«I@DpnaL'VÐ¶¤éþº?÷8yz½»VEèæ4Pbí%wðÌ.±áÞä¬Ñ%2Rè$ª«4B¤·.ë º>YËK4¥ÀiÛ³âµ ⏎
	2	S¥ËP]+·A*óÏóS½HïBh¨üMlÛýYå§ðHK[K¡u¦²50áDU¶iõBgNC⏎

.git/objects/6b/c9738762b9a863bf2445a446c56dae003d4c91 less more

Binary diff not shown

.git/objects/82/46856401287180a83f163b2ace11de8c38b00b less more

Binary diff not shown

.git/objects/87/5a05bf2767d149d0b89ecdf1fc806ae0254751 less more

Binary diff not shown

.git/objects/8a/3a9dc69e815c33bcca64566ae3ff04fa721136 less more

Binary diff not shown

.git/objects/a0/a4047bbb51a28963ade7e14a5281153ca1a7f5 less more

Binary diff not shown

.git/objects/b2/1a588c8f4cef6e4b34d23ae0cb0756590f40c4 less more

Binary diff not shown

.git/objects/b4/100f88e15ec605aa49a2ad2cc106917c0976e8 less more

Binary diff not shown

.git/objects/c3/6a8d77143de389841313d6eb99900d2b97ead4 less more

Binary diff not shown

.git/objects/c6/1da0558851e649c354c0dfc73629fa253dfc89 less more

Binary diff not shown

.git/objects/d3/786129590ff86a3296ca4e17493af92e82c715 less more

Binary diff not shown

.git/objects/e1/eaa77b8792876d4481dc985064b19042772d58 less more

Binary diff not shown

.git/objects/pack/pack-66b233cbc136bfadde29c1582c21e7333feb9c07.idx less more

Binary diff not shown

.git/objects/pack/pack-66b233cbc136bfadde29c1582c21e7333feb9c07.pack less more

Binary diff not shown

+8

-0

.git/packed-refs less more

	0	# pack-refs with: peeled
	1	1b30a2a1be3a7a12d4d37174927051eb63d7b838 refs/tags/0_06
	2	^2db85b1892d3c761c2cdaaa540f1f9117592b349
	3	04fd83f3c42fe0962724ab2c3fbe7008e339dcd5 refs/tags/0.02
	4	^0270958c291b322fb7719eb891240fbd18cc9f47
	5	a7aaee746bcff33e454cd3aa496c00517210d7f9 refs/tags/0.01
	6	^cecbee2d97a70885e3dc57bba62e0673d894b1e9
	7	10769ed347f340ee0e81d85933ae8f82ff0413da refs/remotes/origin/master

+1

-0

.git/refs/heads/master less more

0

69186a4879a2ddfed228c03e7a25d5455921dfb0

+1

-0

.git/refs/remotes/origin/HEAD less more

0

ref: refs/remotes/origin/master

+3

-0

Changes less more

0	0	Revision history for MooseX-Daemonize
	1	0.09 2009-10-05
	2	* s/no_plan => 1/'no_plan'/g (Dave Rolsky)
	3	* Synchronize Version numbers
1	4
2	5	0.08 Sunday, Sept. 7, 2008
3	6	* t/

+16

-0

IDEAS less more

	0	* 2:36 : mike : A slightly different would be to have another object, which is a
	1	daemon, which is the keeper of the PIDs. It can bind to a port and then your other
	2	objects would actually cause things to happen without needing a PID file.
	3
	4
	5	[12:16] <blblack> I guess what I'm saying is that start() has three possible results: success, already running, failed to start
	6	[12:17] <stevan> I am not as familair as you are with this stuff so I am not 100% of al the things
	7	[12:17] <blblack> and stop() does too: success, not running, failed to stop
	8	[12:17] <stevan> k
	9	[12:17] <stevan> perfect
	10	[12:17] <stevan> I will add em :)
	11	...
	12	[12:18] <stevan> can you map the exit value to those three states (sorry I am not familiar with these details myself)
	13	[12:18] <blblack> for most people, the right answer is that start()'s success/already_running should return OK to the OS, failed returns error
	14	[12:18] <stevan> OK = 0, ERROR = 1?
	15	[12:18] <blblack> and stop()'s success/not_running should also be OK (exit 0)⏎

+56

-4

MANIFEST less more

	0	.cvsignore
	1	.git/COMMIT_EDITMSG
	2	.git/config
	3	.git/description
	4	.git/HEAD
	5	.git/hooks/applypatch-msg
	6	.git/hooks/applypatch-msg.sample
	7	.git/hooks/commit-msg
	8	.git/hooks/commit-msg.sample
	9	.git/hooks/post-commit
	10	.git/hooks/post-commit.sample
	11	.git/hooks/post-receive
	12	.git/hooks/post-receive.sample
	13	.git/hooks/post-update
	14	.git/hooks/post-update.sample
	15	.git/hooks/pre-applypatch
	16	.git/hooks/pre-applypatch.sample
	17	.git/hooks/pre-commit
	18	.git/hooks/pre-commit.sample
	19	.git/hooks/pre-rebase
	20	.git/hooks/pre-rebase.sample
	21	.git/hooks/prepare-commit-msg
	22	.git/hooks/prepare-commit-msg.sample
	23	.git/hooks/update
	24	.git/hooks/update.sample
	25	.git/index
	26	.git/info/exclude
	27	.git/logs/HEAD
	28	.git/logs/refs/heads/master
	29	.git/logs/refs/remotes/origin/HEAD
	30	.git/objects/03/30a27f596ae6a5b60e54cdef23a6e4dcefeaf3
	31	.git/objects/1f/070dff6004310ba11c3525f1ac8508c69ab8a5
	32	.git/objects/28/41cd7f04dbb7c8cd04c0c5fa64c939b9393615
	33	.git/objects/33/aa69e3767ca7dfaeaa92119695b796e06f1bd4
	34	.git/objects/69/186a4879a2ddfed228c03e7a25d5455921dfb0
	35	.git/objects/6b/c9738762b9a863bf2445a446c56dae003d4c91
	36	.git/objects/82/46856401287180a83f163b2ace11de8c38b00b
	37	.git/objects/87/5a05bf2767d149d0b89ecdf1fc806ae0254751
	38	.git/objects/8a/3a9dc69e815c33bcca64566ae3ff04fa721136
	39	.git/objects/a0/a4047bbb51a28963ade7e14a5281153ca1a7f5
	40	.git/objects/b2/1a588c8f4cef6e4b34d23ae0cb0756590f40c4
	41	.git/objects/b4/100f88e15ec605aa49a2ad2cc106917c0976e8
	42	.git/objects/c3/6a8d77143de389841313d6eb99900d2b97ead4
	43	.git/objects/c6/1da0558851e649c354c0dfc73629fa253dfc89
	44	.git/objects/d3/786129590ff86a3296ca4e17493af92e82c715
	45	.git/objects/e1/eaa77b8792876d4481dc985064b19042772d58
	46	.git/objects/pack/pack-66b233cbc136bfadde29c1582c21e7333feb9c07.idx
	47	.git/objects/pack/pack-66b233cbc136bfadde29c1582c21e7333feb9c07.pack
	48	.git/packed-refs
	49	.git/refs/heads/master
	50	.git/refs/remotes/origin/HEAD
0	51	Changes
1		inc/Module/AutoInstall.pm
	52	examples/moose_room.pl
	53	IDEAS
2	54	inc/Module/Install.pm
3		inc/Module/Install/AutoInstall.pm
	55	inc/Module/Install/AutoManifest.pm
4	56	inc/Module/Install/Base.pm
5	57	inc/Module/Install/Can.pm
6	58	inc/Module/Install/Fetch.pm
7		inc/Module/Install/Include.pm
8	59	inc/Module/Install/Makefile.pm
9	60	inc/Module/Install/Metadata.pm
10	61	inc/Module/Install/Win32.pm
11	62	inc/Module/Install/WriteAll.pm
	63	lab/dec.pl
12	64	lib/MooseX/Daemonize.pm
13	65	lib/MooseX/Daemonize/Core.pm
14	66	lib/MooseX/Daemonize/Pid.pm

16	68	lib/MooseX/Daemonize/WithPidFile.pm
17	69	lib/Test/MooseX/Daemonize.pm
18	70	Makefile.PL
19		MANIFEST
	71	MANIFEST This list of files
20	72	MANIFEST.SKIP
21	73	META.yml
22	74	README

+10

-7

META.yml less more

0	0	---
1	1	abstract: 'Role for daemonizing your Moose based application'
2	2	author:
3		- 'Chris Prather C<< <perigrin@cpan.org> >>'
	3	- 'Chris Prather C<< <chris@prather.org >>'
4	4	build_requires:
	5	ExtUtils::MakeMaker: 6.42
5	6	Test::More: 0
	7	configure_requires:
	8	ExtUtils::MakeMaker: 6.42
6	9	distribution_type: module
7		generated_by: 'Module::Install version 0.75'
	10	generated_by: 'Module::Install version 0.91'
8	11	license: perl
9	12	meta-spec:
10		url: http://module-build.sourceforge.net/META-spec-v1.3.html
11		version: 1.3
	13	url: http://module-build.sourceforge.net/META-spec-v1.4.html
	14	version: 1.4
12	15	name: MooseX-Daemonize
13	16	no_index:
14	17	directory:
15	18	- examples
16	19	- inc
17	20	- t
18		- examples
19		- examples
20	21	requires:
21	22	Moose: 0.33
22	23	MooseX::Getopt: 0.07
23	24	MooseX::Types::Path::Class: 0
24		version: 0.08
	25	resources:
	26	license: http://dev.perl.org/licenses/
	27	version: 0.09

+2

-1

Makefile.PL less more

13	13
14	14	no_index 'directory' => 'examples';
15	15
16		auto_install;
	16	auto_manifest;
	17	auto_repository;
17	18	WriteAll;

+120

-0

examples/moose_room.pl less more

	0	package MooseRoom;
	1	use strict;
	2	our $VERSION = '0.0.1';
	3	use Moose;
	4	use POE qw(Component::Server::IRC);
	5
	6	with qw(MooseX::Getopt);
	7	with qw(MooseX::Daemonize);
	8
	9	has servername => (
	10	isa => 'Str',
	11	is => 'ro',
	12	default => sub { 'moose.room' },
	13	);
	14
	15	has nicklen => (
	16	isa => 'Int',
	17	is => 'ro',
	18	default => sub { 15 },
	19	);
	20
	21	has network => (
	22	isa => 'Str',
	23	is => 'ro',
	24	default => sub { 'MooseRoom' },
	25	);
	26
	27	has ircd => (
	28	isa => 'POE::Component::Server::IRC',
	29	is => 'ro',
	30	lazy => 1,
	31	default => sub {
	32	POE::Component::Server::IRC->spawn(
	33	{
	34	servername => $_[0]->servername,
	35	nicklen => $_[0]->nicklen,
	36	network
	37	}
	38	);
	39	},
	40	);
	41
	42	has operators => (
	43	isa => 'ArrayRef',
	44	is => 'ro',
	45	auto_deref => 1,
	46	default => sub {
	47	[ { username => 'perigrin', password => 'hobbit' }, ];
	48	},
	49	);
	50
	51	sub BUILD {
	52	my ($self) = @_;
	53	POE::Session->create( object_states => [ $self => [qw(_start _default)], ],
	54	);
	55
	56	}
	57
	58	sub _start {
	59	my ( $self, $kernel, $heap ) = @_[ OBJECT, KERNEL, HEAP ];
	60	$self->ircd->yield('register');
	61
	62	# Anyone connecting from the loopback gets spoofed hostname
	63	$self->ircd->add_auth(
	64	mask => '*@localhost',
	65	spoof => $self->hostname,
	66	no_tilde => 1
	67	);
	68
	69	# We have to add an auth as we have specified one above.
	70	$self->ircd->add_auth( mask => '@' );
	71
	72	# Start a listener on the 'standard' IRC port.
	73	$self->ircd->add_listener( port => 6667 );
	74
	75	# Add an operator who can connect from localhost
	76	$self->ircd->add_operator($_) for $self->operators;
	77	return;
	78	}
	79
	80	sub _default {
	81	my ( $event, $args ) = @_[ ARG0 .. $#_ ];
	82	print STDOUT "$event: ";
	83	foreach (@$args) {
	84	SWITCH: {
	85	if ( ref($_) eq 'ARRAY' ) {
	86	print STDOUT "[", join( ", ", @$_ ), "] ";
	87	last SWITCH;
	88	}
	89	if ( ref($_) eq 'HASH' ) {
	90	print STDOUT "{", join( ", ", %$_ ), "} ";
	91	last SWITCH;
	92	}
	93	print STDOUT "'$_' ";
	94	}
	95	}
	96	print STDOUT "\n";
	97	return 0; # Don't handle signals.
	98	}
	99
	100	before new => sub { POE::Kernel->run(); };
	101	after start => sub { POE::Kernel->run(); };
	102
	103	unless ( caller() ) {
	104	require Cwd;
	105	my $cmd = lc $ARGV[-1];
	106	my $app = MooseRoom->new_with_options( pidbase => Cwd::cwd() );
	107	print STDERR "trying to $cmd server\n";
	108	if ( $cmd eq 'start' ) {
	109	print STDERR qq{
	110	pidfile: @{ [ $app->pidfile ] }
	111	port: @{ [ $app->Port ] }
	112	};
	113	}
	114	$app->$cmd;
	115	}
	116
	117	no Moose;
	118	1; # Magic true value required at end of module
	119	__END__

+0

-768

~~inc/Module/AutoInstall.pm~~ less more

0		#line 1
1		package Module::AutoInstall;
2
3		use strict;
4		use Cwd ();
5		use ExtUtils::MakeMaker ();
6
7		use vars qw{$VERSION};
8		BEGIN {
9		$VERSION = '1.03';
10		}
11
12		# special map on pre-defined feature sets
13		my %FeatureMap = (
14		'' => 'Core Features', # XXX: deprecated
15		'-core' => 'Core Features',
16		);
17
18		# various lexical flags
19		my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS );
20		my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly );
21		my ( $PostambleActions, $PostambleUsed );
22
23		# See if it's a testing or non-interactive session
24		_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN );
25		_init();
26
27		sub _accept_default {
28		$AcceptDefault = shift;
29		}
30
31		sub missing_modules {
32		return @Missing;
33		}
34
35		sub do_install {
36		__PACKAGE__->install(
37		[
38		$Config
39		? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
40		: ()
41		],
42		@Missing,
43		);
44		}
45
46		# initialize various flags, and/or perform install
47		sub _init {
48		foreach my $arg (
49		@ARGV,
50		split(
51		/[\s\t]+/,
52		$ENV{PERL_AUTOINSTALL} \|\| $ENV{PERL_EXTUTILS_AUTOINSTALL} \|\| ''
53		)
54		)
55		{
56		if ( $arg =~ /^--config=(.*)$/ ) {
57		$Config = [ split( ',', $1 ) ];
58		}
59		elsif ( $arg =~ /^--installdeps=(.*)$/ ) {
60		__PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
61		exit 0;
62		}
63		elsif ( $arg =~ /^--default(?:deps)?$/ ) {
64		$AcceptDefault = 1;
65		}
66		elsif ( $arg =~ /^--check(?:deps)?$/ ) {
67		$CheckOnly = 1;
68		}
69		elsif ( $arg =~ /^--skip(?:deps)?$/ ) {
70		$SkipInstall = 1;
71		}
72		elsif ( $arg =~ /^--test(?:only)?$/ ) {
73		$TestOnly = 1;
74		}
75		}
76		}
77
78		# overrides MakeMaker's prompt() to automatically accept the default choice
79		sub _prompt {
80		goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault;
81
82		my ( $prompt, $default ) = @_;
83		my $y = ( $default =~ /^[Yy]/ );
84
85		print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] ';
86		print "$default\n";
87		return $default;
88		}
89
90		# the workhorse
91		sub import {
92		my $class = shift;
93		my @args = @_ or return;
94		my $core_all;
95
96		print "*** $class version " . $class->VERSION . "\n";
97		print "*** Checking for Perl dependencies...\n";
98
99		my $cwd = Cwd::cwd();
100
101		$Config = [];
102
103		my $maxlen = length(
104		(
105		sort { length($b) <=> length($a) }
106		grep { /^[^\-]/ }
107		map {
108		ref($_)
109		? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
110		: ''
111		}
112		map { +{@args}->{$_} }
113		grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
114		)[0]
115		);
116
117		while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
118		my ( @required, @tests, @skiptests );
119		my $default = 1;
120		my $conflict = 0;
121
122		if ( $feature =~ m/^-(\w+)$/ ) {
123		my $option = lc($1);
124
125		# check for a newer version of myself
126		_update_to( $modules, @_ ) and return if $option eq 'version';
127
128		# sets CPAN configuration options
129		$Config = $modules if $option eq 'config';
130
131		# promote every features to core status
132		$core_all = ( $modules =~ /^all$/i ) and next
133		if $option eq 'core';
134
135		next unless $option eq 'core';
136		}
137
138		print "[" . ( $FeatureMap{ lc($feature) } \|\| $feature ) . "]\n";
139
140		$modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );
141
142		unshift @$modules, -default => &{ shift(@$modules) }
143		if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability
144
145		while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
146		if ( $mod =~ m/^-(\w+)$/ ) {
147		my $option = lc($1);
148
149		$default = $arg if ( $option eq 'default' );
150		$conflict = $arg if ( $option eq 'conflict' );
151		@tests = @{$arg} if ( $option eq 'tests' );
152		@skiptests = @{$arg} if ( $option eq 'skiptests' );
153
154		next;
155		}
156
157		printf( "- %-${maxlen}s ...", $mod );
158
159		if ( $arg and $arg =~ /^\D/ ) {
160		unshift @$modules, $arg;
161		$arg = 0;
162		}
163
164		# XXX: check for conflicts and uninstalls(!) them.
165		if (
166		defined( my $cur = _version_check( _load($mod), $arg \|\|= 0 ) ) )
167		{
168		print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
169		push @Existing, $mod => $arg;
170		$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
171		}
172		else {
173		print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
174		push @required, $mod => $arg;
175		}
176		}
177
178		next unless @required;
179
180		my $mandatory = ( $feature eq '-core' or $core_all );
181
182		if (
183		!$SkipInstall
184		and (
185		$CheckOnly
186		or _prompt(
187		qq{==> Auto-install the }
188		. ( @required / 2 )
189		. ( $mandatory ? ' mandatory' : ' optional' )
190		. qq{ module(s) from CPAN?},
191		$default ? 'y' : 'n',
192		) =~ /^[Yy]/
193		)
194		)
195		{
196		push( @Missing, @required );
197		$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
198		}
199
200		elsif ( !$SkipInstall
201		and $default
202		and $mandatory
203		and
204		_prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
205		=~ /^[Nn]/ )
206		{
207		push( @Missing, @required );
208		$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
209		}
210
211		else {
212		$DisabledTests{$_} = 1 for map { glob($_) } @tests;
213		}
214		}
215
216		$UnderCPAN = _check_lock(); # check for $UnderCPAN
217
218		if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) {
219		require Config;
220		print
221		"*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n";
222
223		# make an educated guess of whether we'll need root permission.
224		print " (You may need to do that as the 'root' user.)\n"
225		if eval '$>';
226		}
227		print "*** $class configuration finished.\n";
228
229		chdir $cwd;
230
231		# import to main::
232		no strict 'refs';
233		*{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
234		}
235
236		# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
237		# if we are, then we simply let it taking care of our dependencies
238		sub _check_lock {
239		return unless @Missing;
240
241		if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
242		print <<'END_MESSAGE';
243
244		*** Since we're running under CPANPLUS, I'll just let it take care
245		of the dependency's installation later.
246		END_MESSAGE
247		return 1;
248		}
249
250		_load_cpan();
251
252		# Find the CPAN lock-file
253		my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" );
254		return unless -f $lock;
255
256		# Check the lock
257		local *LOCK;
258		return unless open(LOCK, $lock);
259
260		if (
261		( $^O eq 'MSWin32' ? _under_cpan() : <LOCK> == getppid() )
262		and ( $CPAN::Config->{prerequisites_policy} \|\| '' ) ne 'ignore'
263		) {
264		print <<'END_MESSAGE';
265
266		*** Since we're running under CPAN, I'll just let it take care
267		of the dependency's installation later.
268		END_MESSAGE
269		return 1;
270		}
271
272		close LOCK;
273		return;
274		}
275
276		sub install {
277		my $class = shift;
278
279		my $i; # used below to strip leading '-' from config keys
280		my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
281
282		my ( @modules, @installed );
283		while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
284
285		# grep out those already installed
286		if ( defined( _version_check( _load($pkg), $ver ) ) ) {
287		push @installed, $pkg;
288		}
289		else {
290		push @modules, $pkg, $ver;
291		}
292		}
293
294		return @installed unless @modules; # nothing to do
295		return @installed if _check_lock(); # defer to the CPAN shell
296
297		print "*** Installing dependencies...\n";
298
299		return unless _connected_to('cpan.org');
300
301		my %args = @config;
302		my %failed;
303		local *FAILED;
304		if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) {
305		while (<FAILED>) { chomp; $failed{$_}++ }
306		close FAILED;
307
308		my @newmod;
309		while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) {
310		push @newmod, ( $k => $v ) unless $failed{$k};
311		}
312		@modules = @newmod;
313		}
314
315		if ( _has_cpanplus() ) {
316		_install_cpanplus( \@modules, \@config );
317		} else {
318		_install_cpan( \@modules, \@config );
319		}
320
321		print "*** $class installation finished.\n";
322
323		# see if we have successfully installed them
324		while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
325		if ( defined( _version_check( _load($pkg), $ver ) ) ) {
326		push @installed, $pkg;
327		}
328		elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
329		print FAILED "$pkg\n";
330		}
331		}
332
333		close FAILED if $args{do_once};
334
335		return @installed;
336		}
337
338		sub _install_cpanplus {
339		my @modules = @{ +shift };
340		my @config = _cpanplus_config( @{ +shift } );
341		my $installed = 0;
342
343		require CPANPLUS::Backend;
344		my $cp = CPANPLUS::Backend->new;
345		my $conf = $cp->configure_object;
346
347		return unless $conf->can('conf') # 0.05x+ with "sudo" support
348		or _can_write($conf->_get_build('base')); # 0.04x
349
350		# if we're root, set UNINST=1 to avoid trouble unless user asked for it.
351		my $makeflags = $conf->get_conf('makeflags') \|\| '';
352		if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) {
353		# 0.03+ uses a hashref here
354		$makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST};
355
356		} else {
357		# 0.02 and below uses a scalar
358		$makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
359		if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
360
361		}
362		$conf->set_conf( makeflags => $makeflags );
363		$conf->set_conf( prereqs => 1 );
364
365
366
367		while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) {
368		$conf->set_conf( $key, $val );
369		}
370
371		my $modtree = $cp->module_tree;
372		while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
373		print "*** Installing $pkg...\n";
374
375		MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
376
377		my $success;
378		my $obj = $modtree->{$pkg};
379
380		if ( $obj and defined( _version_check( $obj->{version}, $ver ) ) ) {
381		my $pathname = $pkg;
382		$pathname =~ s/::/\\W/;
383
384		foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
385		delete $INC{$inc};
386		}
387
388		my $rv = $cp->install( modules => [ $obj->{module} ] );
389
390		if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) {
391		print "*** $pkg successfully installed.\n";
392		$success = 1;
393		} else {
394		print "*** $pkg installation cancelled.\n";
395		$success = 0;
396		}
397
398		$installed += $success;
399		} else {
400		print << ".";
401		*** Could not find a version $ver or above for $pkg; skipping.
402		.
403		}
404
405		MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
406		}
407
408		return $installed;
409		}
410
411		sub _cpanplus_config {
412		my @config = ();
413		while ( @_ ) {
414		my ($key, $value) = (shift(), shift());
415		if ( $key eq 'prerequisites_policy' ) {
416		if ( $value eq 'follow' ) {
417		$value = CPANPLUS::Internals::Constants::PREREQ_INSTALL();
418		} elsif ( $value eq 'ask' ) {
419		$value = CPANPLUS::Internals::Constants::PREREQ_ASK();
420		} elsif ( $value eq 'ignore' ) {
421		$value = CPANPLUS::Internals::Constants::PREREQ_IGNORE();
422		} else {
423		die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n";
424		}
425		} else {
426		die "*** Cannot convert option $key to CPANPLUS version.\n";
427		}
428		}
429		return @config;
430		}
431
432		sub _install_cpan {
433		my @modules = @{ +shift };
434		my @config = @{ +shift };
435		my $installed = 0;
436		my %args;
437
438		_load_cpan();
439		require Config;
440
441		if (CPAN->VERSION < 1.80) {
442		# no "sudo" support, probe for writableness
443		return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) )
444		and _can_write( $Config::Config{sitelib} );
445		}
446
447		# if we're root, set UNINST=1 to avoid trouble unless user asked for it.
448		my $makeflags = $CPAN::Config->{make_install_arg} \|\| '';
449		$CPAN::Config->{make_install_arg} =
450		join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
451		if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
452
453		# don't show start-up info
454		$CPAN::Config->{inhibit_startup_message} = 1;
455
456		# set additional options
457		while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
458		( $args{$opt} = $arg, next )
459		if $opt =~ /^force$/; # pseudo-option
460		$CPAN::Config->{$opt} = $arg;
461		}
462
463		local $CPAN::Config->{prerequisites_policy} = 'follow';
464
465		while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
466		MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
467
468		print "*** Installing $pkg...\n";
469
470		my $obj = CPAN::Shell->expand( Module => $pkg );
471		my $success = 0;
472
473		if ( $obj and defined( _version_check( $obj->cpan_version, $ver ) ) ) {
474		my $pathname = $pkg;
475		$pathname =~ s/::/\\W/;
476
477		foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
478		delete $INC{$inc};
479		}
480
481		my $rv = $args{force} ? CPAN::Shell->force( install => $pkg )
482		: CPAN::Shell->install($pkg);
483		$rv \|\|= eval {
484		$CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, )
485		->{install}
486		if $CPAN::META;
487		};
488
489		if ( $rv eq 'YES' ) {
490		print "*** $pkg successfully installed.\n";
491		$success = 1;
492		}
493		else {
494		print "*** $pkg installation failed.\n";
495		$success = 0;
496		}
497
498		$installed += $success;
499		}
500		else {
501		print << ".";
502		*** Could not find a version $ver or above for $pkg; skipping.
503		.
504		}
505
506		MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
507		}
508
509		return $installed;
510		}
511
512		sub _has_cpanplus {
513		return (
514		$HasCPANPLUS = (
515		$INC{'CPANPLUS/Config.pm'}
516		or _load('CPANPLUS::Shell::Default')
517		)
518		);
519		}
520
521		# make guesses on whether we're under the CPAN installation directory
522		sub _under_cpan {
523		require Cwd;
524		require File::Spec;
525
526		my $cwd = File::Spec->canonpath( Cwd::cwd() );
527		my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );
528
529		return ( index( $cwd, $cpan ) > -1 );
530		}
531
532		sub _update_to {
533		my $class = __PACKAGE__;
534		my $ver = shift;
535
536		return
537		if defined( _version_check( _load($class), $ver ) ); # no need to upgrade
538
539		if (
540		_prompt( "==> A newer version of $class ($ver) is required. Install?",
541		'y' ) =~ /^[Nn]/
542		)
543		{
544		die "*** Please install $class $ver manually.\n";
545		}
546
547		print << ".";
548		*** Trying to fetch it from CPAN...
549		.
550
551		# install ourselves
552		_load($class) and return $class->import(@_)
553		if $class->install( [], $class, $ver );
554
555		print << '.'; exit 1;
556
557		*** Cannot bootstrap myself. :-( Installation terminated.
558		.
559		}
560
561		# check if we're connected to some host, using inet_aton
562		sub _connected_to {
563		my $site = shift;
564
565		return (
566		( _load('Socket') and Socket::inet_aton($site) ) or _prompt(
567		qq(
568		*** Your host cannot resolve the domain name '$site', which
569		probably means the Internet connections are unavailable.
570		==> Should we try to install the required module(s) anyway?), 'n'
571		) =~ /^[Yy]/
572		);
573		}
574
575		# check if a directory is writable; may create it on demand
576		sub _can_write {
577		my $path = shift;
578		mkdir( $path, 0755 ) unless -e $path;
579
580		return 1 if -w $path;
581
582		print << ".";
583		*** You are not allowed to write to the directory '$path';
584		the installation may fail due to insufficient permissions.
585		.
586
587		if (
588		eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(
589		qq(
590		==> Should we try to re-execute the autoinstall process with 'sudo'?),
591		((-t STDIN) ? 'y' : 'n')
592		) =~ /^[Yy]/
593		)
594		{
595
596		# try to bootstrap ourselves from sudo
597		print << ".";
598		*** Trying to re-execute the autoinstall process with 'sudo'...
599		.
600		my $missing = join( ',', @Missing );
601		my $config = join( ',',
602		UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
603		if $Config;
604
605		return
606		unless system( 'sudo', $^X, $0, "--config=$config",
607		"--installdeps=$missing" );
608
609		print << ".";
610		*** The 'sudo' command exited with error! Resuming...
611		.
612		}
613
614		return _prompt(
615		qq(
616		==> Should we try to install the required module(s) anyway?), 'n'
617		) =~ /^[Yy]/;
618		}
619
620		# load a module and return the version it reports
621		sub _load {
622		my $mod = pop; # class/instance doesn't matter
623		my $file = $mod;
624
625		$file =~ s\|::\|/\|g;
626		$file .= '.pm';
627
628		local $@;
629		return eval { require $file; $mod->VERSION } \|\| ( $@ ? undef: 0 );
630		}
631
632		# Load CPAN.pm and it's configuration
633		sub _load_cpan {
634		return if $CPAN::VERSION;
635		require CPAN;
636		if ( $CPAN::HandleConfig::VERSION ) {
637		# Newer versions of CPAN have a HandleConfig module
638		CPAN::HandleConfig->load;
639		} else {
640		# Older versions had the load method in Config directly
641		CPAN::Config->load;
642		}
643		}
644
645		# compare two versions, either use Sort::Versions or plain comparison
646		sub _version_check {
647		my ( $cur, $min ) = @_;
648		return unless defined $cur;
649
650		$cur =~ s/\s+$//;
651
652		# check for version numbers that are not in decimal format
653		if ( ref($cur) or ref($min) or $cur =~ /v\|\..\./ or $min =~ /v\|\..\./ ) {
654		if ( ( $version::VERSION or defined( _load('version') )) and
655		version->can('new')
656		) {
657
658		# use version.pm if it is installed.
659		return (
660		( version->new($cur) >= version->new($min) ) ? $cur : undef );
661		}
662		elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
663		{
664
665		# use Sort::Versions as the sorting algorithm for a.b.c versions
666		return ( ( Sort::Versions::versioncmp( $cur, $min ) != -1 )
667		? $cur
668		: undef );
669		}
670
671		warn "Cannot reliably compare non-decimal formatted versions.\n"
672		. "Please install version.pm or Sort::Versions.\n";
673		}
674
675		# plain comparison
676		local $^W = 0; # shuts off 'not numeric' bugs
677		return ( $cur >= $min ? $cur : undef );
678		}
679
680		# nothing; this usage is deprecated.
681		sub main::PREREQ_PM { return {}; }
682
683		sub _make_args {
684		my %args = @_;
685
686		$args{PREREQ_PM} = { %{ $args{PREREQ_PM} \|\| {} }, @Existing, @Missing }
687		if $UnderCPAN or $TestOnly;
688
689		if ( $args{EXE_FILES} and -e 'MANIFEST' ) {
690		require ExtUtils::Manifest;
691		my $manifest = ExtUtils::Manifest::maniread('MANIFEST');
692
693		$args{EXE_FILES} =
694		[ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ];
695		}
696
697		$args{test}{TESTS} \|\|= 't/*.t';
698		$args{test}{TESTS} = join( ' ',
699		grep { !exists( $DisabledTests{$_} ) }
700		map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );
701
702		my $missing = join( ',', @Missing );
703		my $config =
704		join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
705		if $Config;
706
707		$PostambleActions = (
708		$missing
709		? "\$(PERL) $0 --config=$config --installdeps=$missing"
710		: "\$(NOECHO) \$(NOOP)"
711		);
712
713		return %args;
714		}
715
716		# a wrapper to ExtUtils::MakeMaker::WriteMakefile
717		sub Write {
718		require Carp;
719		Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
720
721		if ($CheckOnly) {
722		print << ".";
723		*** Makefile not written in check-only mode.
724		.
725		return;
726		}
727
728		my %args = _make_args(@_);
729
730		no strict 'refs';
731
732		$PostambleUsed = 0;
733		local *MY::postamble = \&postamble unless defined &MY::postamble;
734		ExtUtils::MakeMaker::WriteMakefile(%args);
735
736		print << "." unless $PostambleUsed;
737		*** WARNING: Makefile written with customized MY::postamble() without
738		including contents from Module::AutoInstall::postamble() --
739		auto installation features disabled. Please contact the author.
740		.
741
742		return 1;
743		}
744
745		sub postamble {
746		$PostambleUsed = 1;
747
748		return << ".";
749
750		config :: installdeps
751		\t\$(NOECHO) \$(NOOP)
752
753		checkdeps ::
754		\t\$(PERL) $0 --checkdeps
755
756		installdeps ::
757		\t$PostambleActions
758
759		.
760
761		}
762
763		1;
764
765		__END__
766
767		#line 1003

+0

-61

~~inc/Module/Install/AutoInstall.pm~~ less more

0		#line 1
1		package Module::Install::AutoInstall;
2
3		use strict;
4		use Module::Install::Base;
5
6		use vars qw{$VERSION $ISCORE @ISA};
7		BEGIN {
8		$VERSION = '0.75';
9		$ISCORE = 1;
10		@ISA = qw{Module::Install::Base};
11		}
12
13		sub AutoInstall { $_[0] }
14
15		sub run {
16		my $self = shift;
17		$self->auto_install_now(@_);
18		}
19
20		sub write {
21		my $self = shift;
22		$self->auto_install(@_);
23		}
24
25		sub auto_install {
26		my $self = shift;
27		return if $self->{done}++;
28
29		# Flatten array of arrays into a single array
30		my @core = map @$_, map @$_, grep ref,
31		$self->build_requires, $self->requires;
32
33		my @config = @_;
34
35		# We'll need Module::AutoInstall
36		$self->include('Module::AutoInstall');
37		require Module::AutoInstall;
38
39		Module::AutoInstall->import(
40		(@config ? (-config => \@config) : ()),
41		(@core ? (-core => \@core) : ()),
42		$self->features,
43		);
44
45		$self->makemaker_args( Module::AutoInstall::_make_args() );
46
47		my $class = ref($self);
48		$self->postamble(
49		"# --- $class section:\n" .
50		Module::AutoInstall::postamble()
51		);
52		}
53
54		sub auto_install_now {
55		my $self = shift;
56		$self->auto_install(@_);
57		Module::AutoInstall::do_install();
58		}
59
60		1;

+45

-0

inc/Module/Install/AutoManifest.pm less more

	0	#line 1
	1	use strict;
	2	use warnings;
	3
	4	package Module::Install::AutoManifest;
	5
	6	use Module::Install::Base;
	7
	8	BEGIN {
	9	our $VERSION = '0.003';
	10	our $ISCORE = 1;
	11	our @ISA = qw(Module::Install::Base);
	12	}
	13
	14	sub auto_manifest {
	15	my ($self) = @_;
	16
	17	return unless $Module::Install::AUTHOR;
	18
	19	die "auto_manifest requested, but no MANIFEST.SKIP exists\n"
	20	unless -e "MANIFEST.SKIP";
	21
	22	if (-e "MANIFEST") {
	23	unlink('MANIFEST') or die "Can't remove MANIFEST: $!";
	24	}
	25
	26	$self->postamble(<<"END");
	27	create_distdir: manifest_clean manifest
	28
	29	distclean :: manifest_clean
	30
	31	manifest_clean:
	32	\t\$(RM_F) MANIFEST
	33	END
	34
	35	}
	36
	37	1;
	38	__END__
	39
	40	#line 48
	41
	42	#line 131
	43
	44	1; # End of Module::Install::AutoManifest

+34

-26

inc/Module/Install/Base.pm less more

0	0	#line 1
1	1	package Module::Install::Base;
2	2
3		$VERSION = '0.75';
	3	use strict 'vars';
	4	use vars qw{$VERSION};
	5	BEGIN {
	6	$VERSION = '0.91';
	7	}
4	8
5	9	# Suspend handler for "redefined" warnings
6	10	BEGIN {

8	12	$SIG{__WARN__} = sub { $w };
9	13	}
10	14
11		### This is the ONLY module that shouldn't have strict on
12		# use strict;
13
14		#line 41
	15	#line 42
15	16
16	17	sub new {
17		my ($class, %args) = @_;
18
19		foreach my $method ( qw(call load) ) {
20		*{"$class\::$method"} = sub {
21		shift()->_top->$method(@_);
22		} unless defined &{"$class\::$method"};
23		}
24
25		bless( \%args, $class );
	18	my $class = shift;
	19	unless ( defined &{"${class}::call"} ) {
	20	*{"${class}::call"} = sub { shift->_top->call(@_) };
	21	}
	22	unless ( defined &{"${class}::load"} ) {
	23	*{"${class}::load"} = sub { shift->_top->load(@_) };
	24	}
	25	bless { @_ }, $class;
26	26	}
27	27
28	28	#line 61
29	29
30	30	sub AUTOLOAD {
31		my $self = shift;
32		local $@;
33		my $autoload = eval { $self->_top->autoload } or return;
34		goto &$autoload;
	31	local $@;
	32	my $func = eval { shift->_top->autoload } or return;
	33	goto &$func;
35	34	}
36	35
37		#line 76
	36	#line 75
38	37
39		sub _top { $_[0]->{_top} }
	38	sub _top {
	39	$_[0]->{_top};
	40	}
40	41
41		#line 89
	42	#line 90
42	43
43	44	sub admin {
44		$_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new;
	45	$_[0]->_top->{admin}
	46	or
	47	Module::Install::Base::FakeAdmin->new;
45	48	}
46	49
	50	#line 106
	51
47	52	sub is_admin {
48		$_[0]->admin->VERSION;
	53	$_[0]->admin->VERSION;
49	54	}
50	55
51	56	sub DESTROY {}
52	57
53	58	package Module::Install::Base::FakeAdmin;
54	59
55		my $Fake;
56		sub new { $Fake \|\|= bless(\@_, $_[0]) }
	60	my $fake;
	61
	62	sub new {
	63	$fake \|\|= bless(\@_, $_[0]);
	64	}
57	65
58	66	sub AUTOLOAD {}
59	67

66	74
67	75	1;
68	76
69		#line 138
	77	#line 154

+9

-10

inc/Module/Install/Can.pm less more

1	1	package Module::Install::Can;
2	2
3	3	use strict;
4		use Module::Install::Base;
5		use Config ();
6		### This adds a 5.005 Perl version dependency.
7		### This is a bug and will be fixed.
8		use File::Spec ();
9		use ExtUtils::MakeMaker ();
	4	use Config ();
	5	use File::Spec ();
	6	use ExtUtils::MakeMaker ();
	7	use Module::Install::Base ();
10	8
11		use vars qw{$VERSION $ISCORE @ISA};
	9	use vars qw{$VERSION @ISA $ISCORE};
12	10	BEGIN {
13		$VERSION = '0.75';
	11	$VERSION = '0.91';
	12	@ISA = 'Module::Install::Base';
14	13	$ISCORE = 1;
15		@ISA = qw{Module::Install::Base};
16	14	}
17	15
18	16	# check if we can load some module

38	36	return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
39	37
40	38	for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
	39	next if $dir eq '';
41	40	my $abs = File::Spec->catfile($dir, $_[1]);
42	41	return $abs if (-x $abs or $abs = MM->maybe_command($abs));
43	42	}

78	77
79	78	__END__
80	79
81		#line 157
	80	#line 156

+6

-6

inc/Module/Install/Fetch.pm less more

1	1	package Module::Install::Fetch;
2	2
3	3	use strict;
4		use Module::Install::Base;
	4	use Module::Install::Base ();
5	5
6		use vars qw{$VERSION $ISCORE @ISA};
	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '0.75';
	8	$VERSION = '0.91';
	9	@ISA = 'Module::Install::Base';
9	10	$ISCORE = 1;
10		@ISA = qw{Module::Install::Base};
11	11	}
12	12
13	13	sub get_file {
14	14	my ($self, %args) = @_;
15		my ($scheme, $host, $path, $file) =
	15	my ($scheme, $host, $path, $file) =
16	16	$args{url} =~ m\|^(\w+)://([^/]+)(.+)/(.+)\| or return;
17	17
18	18	if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
19	19	$args{url} = $args{ftp_url}
20	20	or (warn("LWP support unavailable!\n"), return);
21		($scheme, $host, $path, $file) =
	21	($scheme, $host, $path, $file) =
22	22	$args{url} =~ m\|^(\w+)://([^/]+)(.+)/(.+)\| or return;
23	23	}
24	24

+0

-34

~~inc/Module/Install/Include.pm~~ less more

0		#line 1
1		package Module::Install::Include;
2
3		use strict;
4		use Module::Install::Base;
5
6		use vars qw{$VERSION $ISCORE @ISA};
7		BEGIN {
8		$VERSION = '0.75';
9		$ISCORE = 1;
10		@ISA = qw{Module::Install::Base};
11		}
12
13		sub include {
14		shift()->admin->include(@_);
15		}
16
17		sub include_deps {
18		shift()->admin->include_deps(@_);
19		}
20
21		sub auto_include {
22		shift()->admin->auto_include(@_);
23		}
24
25		sub auto_include_deps {
26		shift()->admin->auto_include_deps(@_);
27		}
28
29		sub auto_include_dependent_dists {
30		shift()->admin->auto_include_dependent_dists(@_);
31		}
32
33		1;

+43

-20

inc/Module/Install/Makefile.pm less more

1	1	package Module::Install::Makefile;
2	2
3	3	use strict 'vars';
4		use Module::Install::Base;
5		use ExtUtils::MakeMaker ();
6
7		use vars qw{$VERSION $ISCORE @ISA};
	4	use ExtUtils::MakeMaker ();
	5	use Module::Install::Base ();
	6
	7	use vars qw{$VERSION @ISA $ISCORE};
8	8	BEGIN {
9		$VERSION = '0.75';
	9	$VERSION = '0.91';
	10	@ISA = 'Module::Install::Base';
10	11	$ISCORE = 1;
11		@ISA = qw{Module::Install::Base};
12	12	}
13	13
14	14	sub Makefile { $_[0] }

35	35
36	36	sub makemaker_args {
37	37	my $self = shift;
38		my $args = ($self->{makemaker_args} \|\|= {});
39		%$args = ( %$args, @_ ) if @_;
40		$args;
	38	my $args = ( $self->{makemaker_args} \|\|= {} );
	39	%$args = ( %$args, @_ );
	40	return $args;
41	41	}
42	42
43	43	# For mm args that take multiple space-seperated args,

63	63	my $self = shift;
64	64	my $clean = $self->makemaker_args->{clean} \|\|= {};
65	65	%$clean = (
66		%$clean,
	66	%$clean,
67	67	FILES => join ' ', grep { length $_ } ($clean->{FILES} \|\| (), @_),
68	68	);
69	69	}

72	72	my $self = shift;
73	73	my $realclean = $self->makemaker_args->{realclean} \|\|= {};
74	74	%$realclean = (
75		%$realclean,
	75	%$realclean,
76	76	FILES => join ' ', grep { length $_ } ($realclean->{FILES} \|\| (), @_),
77	77	);
78	78	}

113	113	my $self = shift;
114	114	die "&Makefile->write() takes no arguments\n" if @_;
115	115
116		# Make sure we have a new enough
	116	# Check the current Perl version
	117	my $perl_version = $self->perl_version;
	118	if ( $perl_version ) {
	119	eval "use $perl_version; 1"
	120	or die "ERROR: perl: Version $] is installed, "
	121	. "but we need version >= $perl_version";
	122	}
	123
	124	# Make sure we have a new enough MakeMaker
117	125	require ExtUtils::MakeMaker;
118		$self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION );
119
120		# Generate the
	126
	127	if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
	128	# MakeMaker can complain about module versions that include
	129	# an underscore, even though its own version may contain one!
	130	# Hence the funny regexp to get rid of it. See RT #35800
	131	# for details.
	132	$self->build_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
	133	$self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
	134	} else {
	135	# Allow legacy-compatibility with 5.005 by depending on the
	136	# most recent EU:MM that supported 5.005.
	137	$self->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
	138	$self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 );
	139	}
	140
	141	# Generate the MakeMaker params
121	142	my $args = $self->makemaker_args;
122	143	$args->{DISTNAME} = $self->name;
123	144	$args->{NAME} = $self->module_name \|\| $self->name;

126	147	if ( $self->tests ) {
127	148	$args->{test} = { TESTS => $self->tests };
128	149	}
129		if ($] >= 5.005) {
	150	if ( $] >= 5.005 ) {
130	151	$args->{ABSTRACT} = $self->abstract;
131	152	$args->{AUTHOR} = $self->author;
132	153	}

140	161	delete $args->{SIGN};
141	162	}
142	163
143		# merge both kinds of requires into prereq_pm
	164	# Merge both kinds of requires into prereq_pm
144	165	my $prereq = ($args->{PREREQ_PM} \|\|= {});
145	166	%$prereq = ( %$prereq,
146	167	map { @$_ }

174	195
175	196	my $user_preop = delete $args{dist}->{PREOP};
176	197	if (my $preop = $self->admin->preop($user_preop)) {
177		$args{dist} = $preop;
	198	foreach my $key ( keys %$preop ) {
	199	$args{dist}->{$key} = $preop->{$key};
	200	}
178	201	}
179	202
180	203	my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);

187	210	my $top_class = ref($self->_top) \|\| '';
188	211	my $top_version = $self->_top->VERSION \|\| '';
189	212
190		my $preamble = $self->preamble
	213	my $preamble = $self->preamble
191	214	? "# Preamble by $top_class $top_version\n"
192	215	. $self->preamble
193	216	: '';

241	264
242	265	__END__
243	266
244		#line 371
	267	#line 394

+344

-127

inc/Module/Install/Metadata.pm less more

1	1	package Module::Install::Metadata;
2	2
3	3	use strict 'vars';
4		use Module::Install::Base;
5
6		use vars qw{$VERSION $ISCORE @ISA};
	4	use Module::Install::Base ();
	5
	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '0.75';
	8	$VERSION = '0.91';
	9	@ISA = 'Module::Install::Base';
9	10	$ISCORE = 1;
10		@ISA = qw{Module::Install::Base};
11		}
	11	}
	12
	13	my @boolean_keys = qw{
	14	sign
	15	};
12	16
13	17	my @scalar_keys = qw{
14	18	name

16	20	abstract
17	21	author
18	22	version
19		license
20	23	distribution_type
21		perl_version
22	24	tests
23	25	installdirs
24	26	};

32	34	resources
33	35	};
34	36
35		sub Meta { shift }
36		sub Meta_ScalarKeys { @scalar_keys }
37		sub Meta_TupleKeys { @tuple_keys }
38
39		foreach my $key (@scalar_keys) {
	37	my @resource_keys = qw{
	38	homepage
	39	bugtracker
	40	repository
	41	};
	42
	43	my @array_keys = qw{
	44	keywords
	45	};
	46
	47	sub Meta { shift }
	48	sub Meta_BooleanKeys { @boolean_keys }
	49	sub Meta_ScalarKeys { @scalar_keys }
	50	sub Meta_TupleKeys { @tuple_keys }
	51	sub Meta_ResourceKeys { @resource_keys }
	52	sub Meta_ArrayKeys { @array_keys }
	53
	54	foreach my $key ( @boolean_keys ) {
40	55	*$key = sub {
41	56	my $self = shift;
42		return $self->{values}{$key} if defined wantarray and !@_;
43		$self->{values}{$key} = shift;
	57	if ( defined wantarray and not @_ ) {
	58	return $self->{values}->{$key};
	59	}
	60	$self->{values}->{$key} = ( @_ ? $_[0] : 1 );
44	61	return $self;
45	62	};
46	63	}
47	64
48		sub requires {
	65	foreach my $key ( @scalar_keys ) {
	66	*$key = sub {
	67	my $self = shift;
	68	return $self->{values}->{$key} if defined wantarray and !@_;
	69	$self->{values}->{$key} = shift;
	70	return $self;
	71	};
	72	}
	73
	74	foreach my $key ( @array_keys ) {
	75	*$key = sub {
	76	my $self = shift;
	77	return $self->{values}->{$key} if defined wantarray and !@_;
	78	$self->{values}->{$key} \|\|= [];
	79	push @{$self->{values}->{$key}}, @_;
	80	return $self;
	81	};
	82	}
	83
	84	foreach my $key ( @resource_keys ) {
	85	*$key = sub {
	86	my $self = shift;
	87	unless ( @_ ) {
	88	return () unless $self->{values}->{resources};
	89	return map { $_->[1] }
	90	grep { $_->[0] eq $key }
	91	@{ $self->{values}->{resources} };
	92	}
	93	return $self->{values}->{resources}->{$key} unless @_;
	94	my $uri = shift or die(
	95	"Did not provide a value to $key()"
	96	);
	97	$self->resources( $key => $uri );
	98	return 1;
	99	};
	100	}
	101
	102	foreach my $key ( grep { $_ ne "resources" } @tuple_keys) {
	103	*$key = sub {
	104	my $self = shift;
	105	return $self->{values}->{$key} unless @_;
	106	my @added;
	107	while ( @_ ) {
	108	my $module = shift or last;
	109	my $version = shift \|\| 0;
	110	push @added, [ $module, $version ];
	111	}
	112	push @{ $self->{values}->{$key} }, @added;
	113	return map {@$_} @added;
	114	};
	115	}
	116
	117	# Resource handling
	118	my %lc_resource = map { $_ => 1 } qw{
	119	homepage
	120	license
	121	bugtracker
	122	repository
	123	};
	124
	125	sub resources {
49	126	my $self = shift;
50	127	while ( @_ ) {
51		my $module = shift or last;
52		my $version = shift \|\| 0;
53		push @{ $self->{values}->{requires} }, [ $module, $version ];
54		}
55		$self->{values}{requires};
56		}
57
58		sub build_requires {
59		my $self = shift;
60		while ( @_ ) {
61		my $module = shift or last;
62		my $version = shift \|\| 0;
63		push @{ $self->{values}->{build_requires} }, [ $module, $version ];
64		}
65		$self->{values}{build_requires};
66		}
67
68		sub configure_requires {
69		my $self = shift;
70		while ( @_ ) {
71		my $module = shift or last;
72		my $version = shift \|\| 0;
73		push @{ $self->{values}->{configure_requires} }, [ $module, $version ];
74		}
75		$self->{values}->{configure_requires};
76		}
77
78		sub recommends {
79		my $self = shift;
80		while ( @_ ) {
81		my $module = shift or last;
82		my $version = shift \|\| 0;
83		push @{ $self->{values}->{recommends} }, [ $module, $version ];
84		}
85		$self->{values}->{recommends};
86		}
87
88		sub bundles {
89		my $self = shift;
90		while ( @_ ) {
91		my $module = shift or last;
92		my $version = shift \|\| 0;
93		push @{ $self->{values}->{bundles} }, [ $module, $version ];
94		}
95		$self->{values}->{bundles};
96		}
97
98		# Resource handling
99		sub resources {
100		my $self = shift;
101		while ( @_ ) {
102		my $resource = shift or last;
103		my $value = shift or next;
104		push @{ $self->{values}->{resources} }, [ $resource, $value ];
	128	my $name = shift or last;
	129	my $value = shift or next;
	130	if ( $name eq lc $name and ! $lc_resource{$name} ) {
	131	die("Unsupported reserved lowercase resource '$name'");
	132	}
	133	$self->{values}->{resources} \|\|= [];
	134	push @{ $self->{values}->{resources} }, [ $name, $value ];
105	135	}
106	136	$self->{values}->{resources};
107		}
108
109		sub repository {
110		my $self = shift;
111		$self->resources( repository => shift );
112		return 1;
113	137	}
114	138
115	139	# Aliases for build_requires that will have alternative
116	140	# meanings in some future version of META.yml.
117		sub test_requires { shift->build_requires(@_) }
118		sub install_requires { shift->build_requires(@_) }
	141	sub test_requires { shift->build_requires(@_) }
	142	sub install_requires { shift->build_requires(@_) }
119	143
120	144	# Aliases for installdirs options
121		sub install_as_core { $_[0]->installdirs('perl') }
122		sub install_as_cpan { $_[0]->installdirs('site') }
123		sub install_as_site { $_[0]->installdirs('site') }
124		sub install_as_vendor { $_[0]->installdirs('vendor') }
125
126		sub sign {
127		my $self = shift;
128		return $self->{'values'}{'sign'} if defined wantarray and ! @_;
129		$self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 );
130		return $self;
131		}
	145	sub install_as_core { $_[0]->installdirs('perl') }
	146	sub install_as_cpan { $_[0]->installdirs('site') }
	147	sub install_as_site { $_[0]->installdirs('site') }
	148	sub install_as_vendor { $_[0]->installdirs('vendor') }
132	149
133	150	sub dynamic_config {
134	151	my $self = shift;
135	152	unless ( @_ ) {
136		warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n";
	153	warn "You MUST provide an explicit true/false value to dynamic_config\n";
137	154	return $self;
138	155	}
139		$self->{values}{dynamic_config} = $_[0] ? 1 : 0;
140		return $self;
	156	$self->{values}->{dynamic_config} = $_[0] ? 1 : 0;
	157	return 1;
	158	}
	159
	160	sub perl_version {
	161	my $self = shift;
	162	return $self->{values}->{perl_version} unless @_;
	163	my $version = shift or die(
	164	"Did not provide a value to perl_version()"
	165	);
	166
	167	# Normalize the version
	168	$version = $self->_perl_version($version);
	169
	170	# We don't support the reall old versions
	171	unless ( $version >= 5.005 ) {
	172	die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
	173	}
	174
	175	$self->{values}->{perl_version} = $version;
	176	}
	177
	178	#Stolen from M::B
	179	my %license_urls = (
	180	perl => 'http://dev.perl.org/licenses/',
	181	apache => 'http://apache.org/licenses/LICENSE-2.0',
	182	artistic => 'http://opensource.org/licenses/artistic-license.php',
	183	artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
	184	lgpl => 'http://opensource.org/licenses/lgpl-license.php',
	185	lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
	186	lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
	187	bsd => 'http://opensource.org/licenses/bsd-license.php',
	188	gpl => 'http://opensource.org/licenses/gpl-license.php',
	189	gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
	190	gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
	191	mit => 'http://opensource.org/licenses/mit-license.php',
	192	mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
	193	open_source => undef,
	194	unrestricted => undef,
	195	restrictive => undef,
	196	unknown => undef,
	197	);
	198
	199	sub license {
	200	my $self = shift;
	201	return $self->{values}->{license} unless @_;
	202	my $license = shift or die(
	203	'Did not provide a value to license()'
	204	);
	205	$self->{values}->{license} = $license;
	206
	207	# Automatically fill in license URLs
	208	if ( $license_urls{$license} ) {
	209	$self->resources( license => $license_urls{$license} );
	210	}
	211
	212	return 1;
141	213	}
142	214
143	215	sub all_from {
144	216	my ( $self, $file ) = @_;
145	217
146	218	unless ( defined($file) ) {
147		my $name = $self->name
148		or die "all_from called with no args without setting name() first";
	219	my $name = $self->name or die(
	220	"all_from called with no args without setting name() first"
	221	);
149	222	$file = join('/', 'lib', split(/-/, $name)) . '.pm';
150	223	$file =~ s{.*/}{} unless -e $file;
151		die "all_from: cannot find $file from $name" unless -e $file;
	224	unless ( -e $file ) {
	225	die("all_from cannot find $file from $name");
	226	}
	227	}
	228	unless ( -f $file ) {
	229	die("The path '$file' does not exist, or is not a file");
152	230	}
153	231
154	232	# Some methods pull from POD instead of code.

170	248
171	249	sub provides {
172	250	my $self = shift;
173		my $provides = ( $self->{values}{provides} \|\|= {} );
	251	my $provides = ( $self->{values}->{provides} \|\|= {} );
174	252	%$provides = (%$provides, @_) if @_;
175	253	return $provides;
176	254	}

199	277	sub feature {
200	278	my $self = shift;
201	279	my $name = shift;
202		my $features = ( $self->{values}{features} \|\|= [] );
	280	my $features = ( $self->{values}->{features} \|\|= [] );
203	281	my $mods;
204	282
205	283	if ( @_ == 1 and ref( $_[0] ) ) {

235	313	sub no_index {
236	314	my $self = shift;
237	315	my $type = shift;
238		push @{ $self->{values}{no_index}{$type} }, @_ if $type;
239		return $self->{values}{no_index};
	316	push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
	317	return $self->{values}->{no_index};
240	318	}
241	319
242	320	sub read {

302	380	$self->module_name($module_name);
303	381	}
304	382	} else {
305		die "Cannot determine name from $file\n";
	383	die("Cannot determine name from $file\n");
306	384	}
307	385	}
308	386

360	438	/ixms ) {
361	439	my $license_text = $1;
362	440	my @phrases = (
363		'under the same (?:terms\|license) as perl itself' => 'perl', 1,
364		'GNU public license' => 'gpl', 1,
365		'GNU lesser public license' => 'lgpl', 1,
366		'BSD license' => 'bsd', 1,
367		'Artistic license' => 'artistic', 1,
368		'GPL' => 'gpl', 1,
369		'LGPL' => 'lgpl', 1,
370		'BSD' => 'bsd', 1,
371		'Artistic' => 'artistic', 1,
372		'MIT' => 'mit', 1,
373		'proprietary' => 'proprietary', 0,
	441	'under the same (?:terms\|license) as (?:perl\|the perl programming language) itself' => 'perl', 1,
	442	'GNU general public license' => 'gpl', 1,
	443	'GNU public license' => 'gpl', 1,
	444	'GNU lesser general public license' => 'lgpl', 1,
	445	'GNU lesser public license' => 'lgpl', 1,
	446	'GNU library general public license' => 'lgpl', 1,
	447	'GNU library public license' => 'lgpl', 1,
	448	'BSD license' => 'bsd', 1,
	449	'Artistic license' => 'artistic', 1,
	450	'GPL' => 'gpl', 1,
	451	'LGPL' => 'lgpl', 1,
	452	'BSD' => 'bsd', 1,
	453	'Artistic' => 'artistic', 1,
	454	'MIT' => 'mit', 1,
	455	'proprietary' => 'proprietary', 0,
374	456	);
375	457	while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
376	458	$pattern =~ s{\s+}{\\s+}g;
377	459	if ( $license_text =~ /\b$pattern\b/i ) {
378		if ( $osi and $license_text =~ /All rights reserved/i ) {
379		print "WARNING: 'All rights reserved' in copyright may invalidate Open Source license.\n";
380		}
381	460	$self->license($license);
382	461	return 1;
383	462	}

388	467	return 'unknown';
389	468	}
390	469
391		sub install_script {
392		my $self = shift;
393		my $args = $self->makemaker_args;
394		my $exe = $args->{EXE_FILES} \|\|= [];
395		foreach ( @_ ) {
396		if ( -f $_ ) {
397		push @$exe, $_;
398		} elsif ( -d 'script' and -f "script/$_" ) {
399		push @$exe, "script/$_";
400		} else {
401		die "Cannot find script '$_'";
402		}
403		}
	470	sub _extract_bugtracker {
	471	my @links = $_[0] =~ m#L<(\Qhttp://rt.cpan.org/\E[^>]+)>#g;
	472	my %links;
	473	@links{@links}=();
	474	@links=keys %links;
	475	return @links;
	476	}
	477
	478	sub bugtracker_from {
	479	my $self = shift;
	480	my $content = Module::Install::_read($_[0]);
	481	my @links = _extract_bugtracker($content);
	482	unless ( @links ) {
	483	warn "Cannot determine bugtracker info from $_[0]\n";
	484	return 0;
	485	}
	486	if ( @links > 1 ) {
	487	warn "Found more than on rt.cpan.org link in $_[0]\n";
	488	return 0;
	489	}
	490
	491	# Set the bugtracker
	492	bugtracker( $links[0] );
	493	return 1;
	494	}
	495
	496	sub requires_from {
	497	my $self = shift;
	498	my $content = Module::Install::_readperl($_[0]);
	499	my @requires = $content =~ m/^use\s+([^\W\d]\w(?:::\w+))\s+([\d\.]+)/mg;
	500	while ( @requires ) {
	501	my $module = shift @requires;
	502	my $version = shift @requires;
	503	$self->requires( $module => $version );
	504	}
	505	}
	506
	507	sub test_requires_from {
	508	my $self = shift;
	509	my $content = Module::Install::_readperl($_[0]);
	510	my @requires = $content =~ m/^use\s+([^\W\d]\w(?:::\w+))\s+([\d\.]+)/mg;
	511	while ( @requires ) {
	512	my $module = shift @requires;
	513	my $version = shift @requires;
	514	$self->test_requires( $module => $version );
	515	}
	516	}
	517
	518	# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
	519	# numbers (eg, 5.006001 or 5.008009).
	520	# Also, convert double-part versions (eg, 5.8)
	521	sub _perl_version {
	522	my $v = $_[-1];
	523	$v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
	524	$v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0\|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 \|\| 0)/e;
	525	$v =~ s/(\.\d\d\d)000$/$1/;
	526	$v =~ s/_.+$//;
	527	if ( ref($v) ) {
	528	# Numify
	529	$v = $v + 0;
	530	}
	531	return $v;
	532	}
	533
	534
	535
	536
	537
	538	######################################################################
	539	# MYMETA Support
	540
	541	sub WriteMyMeta {
	542	die "WriteMyMeta has been deprecated";
	543	}
	544
	545	sub write_mymeta_yaml {
	546	my $self = shift;
	547
	548	# We need YAML::Tiny to write the MYMETA.yml file
	549	unless ( eval { require YAML::Tiny; 1; } ) {
	550	return 1;
	551	}
	552
	553	# Generate the data
	554	my $meta = $self->_write_mymeta_data or return 1;
	555
	556	# Save as the MYMETA.yml file
	557	print "Writing MYMETA.yml\n";
	558	YAML::Tiny::DumpFile('MYMETA.yml', $meta);
	559	}
	560
	561	sub write_mymeta_json {
	562	my $self = shift;
	563
	564	# We need JSON to write the MYMETA.json file
	565	unless ( eval { require JSON; 1; } ) {
	566	return 1;
	567	}
	568
	569	# Generate the data
	570	my $meta = $self->_write_mymeta_data or return 1;
	571
	572	# Save as the MYMETA.yml file
	573	print "Writing MYMETA.json\n";
	574	Module::Install::_write(
	575	'MYMETA.json',
	576	JSON->new->pretty(1)->canonical->encode($meta),
	577	);
	578	}
	579
	580	sub _write_mymeta_data {
	581	my $self = shift;
	582
	583	# If there's no existing META.yml there is nothing we can do
	584	return undef unless -f 'META.yml';
	585
	586	# We need Parse::CPAN::Meta to load the file
	587	unless ( eval { require Parse::CPAN::Meta; 1; } ) {
	588	return undef;
	589	}
	590
	591	# Merge the perl version into the dependencies
	592	my $val = $self->Meta->{values};
	593	my $perl = delete $val->{perl_version};
	594	if ( $perl ) {
	595	$val->{requires} \|\|= [];
	596	my $requires = $val->{requires};
	597
	598	# Canonize to three-dot version after Perl 5.6
	599	if ( $perl >= 5.006 ) {
	600	$perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2\|\|0), int($3\|\|0))}e
	601	}
	602	unshift @$requires, [ perl => $perl ];
	603	}
	604
	605	# Load the advisory META.yml file
	606	my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
	607	my $meta = $yaml[0];
	608
	609	# Overwrite the non-configure dependency hashs
	610	delete $meta->{requires};
	611	delete $meta->{build_requires};
	612	delete $meta->{recommends};
	613	if ( exists $val->{requires} ) {
	614	$meta->{requires} = { map { @$_ } @{ $val->{requires} } };
	615	}
	616	if ( exists $val->{build_requires} ) {
	617	$meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
	618	}
	619
	620	return $meta;
404	621	}
405	622
406	623	1;

+3

-3

inc/Module/Install/Win32.pm less more

1	1	package Module::Install::Win32;
2	2
3	3	use strict;
4		use Module::Install::Base;
	4	use Module::Install::Base ();
5	5
6	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '0.75';
9		@ISA = qw{Module::Install::Base};
	8	$VERSION = '0.91';
	9	@ISA = 'Module::Install::Base';
10	10	$ISCORE = 1;
11	11	}
12	12

+23

-3

inc/Module/Install/WriteAll.pm less more

1	1	package Module::Install::WriteAll;
2	2
3	3	use strict;
4		use Module::Install::Base;
	4	use Module::Install::Base ();
5	5
6	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '0.75';
	8	$VERSION = '0.91';;
9	9	@ISA = qw{Module::Install::Base};
10	10	$ISCORE = 1;
11	11	}

21	21	);
22	22
23	23	$self->sign(1) if $args{sign};
24		$self->Meta->write if $args{meta};
25	24	$self->admin->WriteAll(%args) if $self->is_admin;
26	25
27	26	$self->check_nmake if $args{check_nmake};

29	28	$self->makemaker_args( PL_FILES => {} );
30	29	}
31	30
	31	# Until ExtUtils::MakeMaker support MYMETA.yml, make sure
	32	# we clean it up properly ourself.
	33	$self->realclean_files('MYMETA.yml');
	34
32	35	if ( $args{inline} ) {
33	36	$self->Inline->write;
34	37	} else {
35	38	$self->Makefile->write;
36	39	}
	40
	41	# The Makefile write process adds a couple of dependencies,
	42	# so write the META.yml files after the Makefile.
	43	if ( $args{meta} ) {
	44	$self->Meta->write;
	45	}
	46
	47	# Experimental support for MYMETA
	48	if ( $ENV{X_MYMETA} ) {
	49	if ( $ENV{X_MYMETA} eq 'JSON' ) {
	50	$self->Meta->write_mymeta_json;
	51	} else {
	52	$self->Meta->write_mymeta_yaml;
	53	}
	54	}
	55
	56	return 1;
37	57	}
38	58
39	59	1;

+101

-24

inc/Module/Install.pm less more

16	16	# 3. The ./inc/ version of Module::Install loads
17	17	# }
18	18
19		BEGIN {
20		require 5.004;
21		}
	19	use 5.005;
22	20	use strict 'vars';
23	21
24		use vars qw{$VERSION};
	22	use vars qw{$VERSION $MAIN};
25	23	BEGIN {
26	24	# All Module::Install core packages now require synchronised versions.
27	25	# This will be used to ensure we don't accidentally load old or

29	27	# This is not enforced yet, but will be some time in the next few
30	28	# releases once we can make sure it won't clash with custom
31	29	# Module::Install extensions.
32		$VERSION = '0.75';
	30	$VERSION = '0.91';
	31
	32	# Storage for the pseudo-singleton
	33	$MAIN = undef;
33	34
34	35	inc::Module::Install::VERSION = VERSION;
35	36	@inc::Module::Install::ISA = __PACKAGE__;

68	69	# again. This is bad. Rather than taking action to touch it (which
69	70	# is unreliable on some platforms and requires write permissions)
70	71	# for now we should catch this and refuse to run.
71		if ( -f $0 and (stat($0))[9] > time ) { die <<"END_DIE" }
72
73		Your installer $0 has a modification time in the future.
	72	if ( -f $0 ) {
	73	my $s = (stat($0))[9];
	74
	75	# If the modification time is only slightly in the future,
	76	# sleep briefly to remove the problem.
	77	my $a = $s - time;
	78	if ( $a > 0 and $a < 5 ) { sleep 5 }
	79
	80	# Too far in the future, throw an error.
	81	my $t = time;
	82	if ( $s > $t ) { die <<"END_DIE" }
	83
	84	Your installer $0 has a modification time in the future ($s > $t).
74	85
75	86	This is known to create infinite loops in make.
76	87
77	88	Please correct this, then run $0 again.
78	89
79	90	END_DIE
	91	}
80	92
81	93
82	94

120	132	$sym->{$cwd} = sub {
121	133	my $pwd = Cwd::cwd();
122	134	if ( my $code = $sym->{$pwd} ) {
123		# delegate back to parent dirs
	135	# Delegate back to parent dirs
124	136	goto &$code unless $cwd eq $pwd;
125	137	}
126	138	$$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
	139	my $method = $1;
	140	if ( uc($method) eq $method ) {
	141	# Do nothing
	142	return;
	143	} elsif ( $method =~ /^_/ and $self->can($method) ) {
	144	# Dispatch to the root M:I class
	145	return $self->$method(@_);
	146	}
	147
	148	# Dispatch to the appropriate plugin
127	149	unshift @_, ( $self, $1 );
128		goto &{$self->can('call')} unless uc($1) eq $1;
	150	goto &{$self->can('call')};
129	151	};
130	152	}
131	153

150	172	delete $INC{"$self->{file}"};
151	173	delete $INC{"$self->{path}.pm"};
152	174
	175	# Save to the singleton
	176	$MAIN = $self;
	177
153	178	return 1;
154	179	}
155	180

163	188
164	189	my @exts = @{$self->{extensions}};
165	190	unless ( @exts ) {
166		my $admin = $self->{admin};
167		@exts = $admin->load_all_extensions;
	191	@exts = $self->{admin}->load_all_extensions;
168	192	}
169	193
170	194	my %seen;

247	271	sub load_extensions {
248	272	my ($self, $path, $top) = @_;
249	273
250		unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) {
	274	unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
251	275	unshift @INC, $self->{prefix};
252	276	}
253	277

311	335
312	336
313	337	#####################################################################
314		# Utility Functions
	338	# Common Utility Functions
315	339
316	340	sub _caller {
317	341	my $depth = 0;

325	349
326	350	sub _read {
327	351	local *FH;
328		open FH, "< $_[0]" or die "open($_[0]): $!";
329		my $str = do { local $/; <FH> };
	352	if ( $] >= 5.006 ) {
	353	open( FH, '<', $_[0] ) or die "open($_[0]): $!";
	354	} else {
	355	open( FH, "< $_[0]" ) or die "open($_[0]): $!";
	356	}
	357	my $string = do { local $/; <FH> };
330	358	close FH or die "close($_[0]): $!";
331		return $str;
	359	return $string;
	360	}
	361
	362	sub _readperl {
	363	my $string = Module::Install::_read($_[0]);
	364	$string =~ s/(?:\015{1,2}\012\|\015\|\012)/\n/sg;
	365	$string =~ s/(\n)\n__(?:DATA\|END)__\b.\z/$1/s;
	366	$string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
	367	return $string;
	368	}
	369
	370	sub _readpod {
	371	my $string = Module::Install::_read($_[0]);
	372	$string =~ s/(?:\015{1,2}\012\|\015\|\012)/\n/sg;
	373	return $string if $_[0] =~ /\.pod\z/;
	374	$string =~ s/(^\|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+\|\z)/$1$2/sg;
	375	$string =~ s/\n=pod\b[^\n]\n+/\n\n/sg;
	376	$string =~ s/\n=cut\b[^\n]\n+/\n\n/sg;
	377	$string =~ s/^\n+//s;
	378	return $string;
332	379	}
333	380
334	381	sub _write {
335	382	local *FH;
336		open FH, "> $_[0]" or die "open($_[0]): $!";
337		foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" }
	383	if ( $] >= 5.006 ) {
	384	open( FH, '>', $_[0] ) or die "open($_[0]): $!";
	385	} else {
	386	open( FH, "> $_[0]" ) or die "open($_[0]): $!";
	387	}
	388	foreach ( 1 .. $#_ ) {
	389	print FH $_[$_] or die "print($_[0]): $!";
	390	}
338	391	close FH or die "close($_[0]): $!";
339	392	}
340	393
341		sub _version {
	394	# _version is for processing module versions (eg, 1.03_05) not
	395	# Perl versions (eg, 5.8.1).
	396	sub _version ($) {
342	397	my $s = shift \|\| 0;
343		$s =~ s/^(\d+)\.?//;
	398	my $d =()= $s =~ /(\.)/g;
	399	if ( $d >= 2 ) {
	400	# Normalise multipart versions
	401	$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
	402	}
	403	$s =~ s/^(\d+)\.?//;
344	404	my $l = $1 \|\| 0;
345		my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
346		$l = $l . '.' . join '', @v if @v;
	405	my @v = map {
	406	$_ . '0' x (3 - length $_)
	407	} $s =~ /(\d{1,3})\D?/g;
	408	$l = $l . '.' . join '', @v if @v;
347	409	return $l + 0;
348	410	}
349	411
	412	sub _cmp ($$) {
	413	_version($_[0]) <=> _version($_[1]);
	414	}
	415
	416	# Cloned from Params::Util::_CLASS
	417	sub _CLASS ($) {
	418	(
	419	defined $_[0]
	420	and
	421	! ref $_[0]
	422	and
	423	$_[0] =~ m/^[^\W\d]\w(?:::\w+)\z/s
	424	) ? $_[0] : undef;
	425	}
	426
350	427	1;
351	428
352		# Copyright 2008 Adam Kennedy.
	429	# Copyright 2008 - 2009 Adam Kennedy.

+29

-0

lab/dec.pl less more

	0	#!/usr/bin/env perl -l
	1
	2	package TestDaemon;
	3	use Moose;
	4	with('MooseX::Daemonize');
	5
	6	before 'daemonize' => sub {
	7	warn 'forking ' . $$;
	8	};
	9
	10	after 'start' => sub {
	11	return unless $_[0]->is_daemon;
	12	while (1) {
	13	local *LOG;
	14	open LOG, '>>', '/tmp/testdaemon.log';
	15	print LOG "$0:$$";
	16	close LOG;
	17	sleep 1;
	18	}
	19	};
	20
	21	package main;
	22	my $td = new_with_options TestDaemon( pidbase => '/tmp' );
	23	use YAML;
	24	warn Dump $td->pidfile;
	25	warn $td->check;
	26	print "PARENT: $$";
	27	print 'PID: ' . $td->get_pid;
	28	print $td->start;

+1

-1

lib/MooseX/Daemonize/Core.pm less more

2	2	use MooseX::Getopt; # to load the NoGetopt metaclass
3	3	use Moose::Role;
4	4
5		our $VERSION = 0.01;
	5	our $VERSION = '0.09';
6	6
7	7	use POSIX ();
8	8

+1

-1

lib/MooseX/Daemonize/Pid/File.pm less more

2	2	use Moose;
3	3	use Moose::Util::TypeConstraints;
4	4
5		our $VERSION = '0.01';
	5	our $VERSION = '0.09';
6	6
7	7	use MooseX::Types::Path::Class;
8	8	use MooseX::Getopt::OptionTypeMap;

+1

-1

lib/MooseX/Daemonize/Pid.pm less more

1	1	use strict; # because Kwalitee is pedantic
2	2	use Moose;
3	3	use Moose::Util::TypeConstraints;
	4	our $VERSION = '0.09';
4	5
5	6	coerce 'MooseX::Daemonize::Pid'
6	7	=> from 'Int'
7	8	=> via { MooseX::Daemonize::Pid->new( pid => $_ ) };
8	9
9		our $VERSION = '0.01';
10	10
11	11	has 'pid' => (
12	12	is => 'rw',

+2

-2

lib/MooseX/Daemonize/WithPidFile.pm less more

1	1	use strict; # cause Perl::Critic errors are annoying
2	2	use MooseX::Getopt; # to load the Getopt metaclass
3	3	use Moose::Role;
	4	our $VERSION = '0.09';
	5
4	6
5	7	use MooseX::Daemonize::Pid::File;
6
7		our $VERSION = 0.01;
8	8
9	9	with 'MooseX::Daemonize::Core';
10	10

+3

-3

lib/MooseX/Daemonize.pm less more

2	2	use Moose::Role;
3	3	use MooseX::Types::Path::Class;
4	4
5		our $VERSION = 0.08;
	5	our $VERSION = "0.09";
6	6
7	7	with 'MooseX::Daemonize::WithPidFile',
8	8	'MooseX::Getopt';

523	523
524	524	=head1 AUTHORS
525	525
526		Chris Prather C<< <perigrin@cpan.org> >>
	526	Chris Prather C<< <chris@prather.org >>
527	527
528	528	Stevan Little C<< <stevan.little@iinteractive.com> >>
529	529

536	536
537	537	=head1 LICENCE AND COPYRIGHT
538	538
539		Copyright (c) 2007-2008, Chris Prather C<< <perigrin@cpan.org> >>. All rights
	539	Copyright (c) 2007-2009, Chris Prather C<< <chris@prather.org> >>. Some rights
540	540	reserved.
541	541
542	542	This module is free software; you can redistribute it and/or

+3

-2

lib/Test/MooseX/Daemonize.pm less more

0	0	package Test::MooseX::Daemonize;
1	1	use strict;
	2
	3	our $VERSION = '0.09';
	4	our $AUTHORITY = 'cpan:PERIGRIN';
2	5
3	6	# BEGIN CARGO CULTING
4	7	use Sub::Exporter;
5	8	use Test::Builder;
6	9
7		our $VERSION = '0.03';
8		our $AUTHORITY = 'cpan:PERIGRIN';
9	10
10	11	{
11	12	my @exports = qw[

+1

-1

t/02.stdout.t less more

0		use Test::More no_plan => 1;
	0	use Test::More 'no_plan';
1	1	use Test::Builder;
2	2	use Test::MooseX::Daemonize;
3	3	use MooseX::Daemonize;

+1

-1

t/20.core.t less more

2	2	use strict;
3	3	use warnings;
4	4
5		use Test::More no_plan => 1;
	5	use Test::More 'no_plan';
6	6	use Test::Exception;
7	7	use Test::Moose;
8	8	use File::Temp qw(tempdir);

+1

-1

t/30.with_pid_file.t less more

4	4
5	5	use File::Spec::Functions;
6	6
7		use Test::More no_plan => 1;
	7	use Test::More 'no_plan';
8	8	use Test::Exception;
9	9	use Test::Moose;
10	10	use File::Temp qw(tempdir);

+1

-1

t/31.with_pid_file_and_poe.t less more

15	15	BEGIN {
16	16	eval 'use POE::Kernel;';
17	17	plan skip_all => "POE required for this test" if $@;
18		plan no_plan => 1;
	18	plan 'no_plan';
19	19	use_ok('MooseX::Daemonize::Core');
20	20
21	21	}