App-BCVI
view release on metacpan or search on metacpan
495051525354555657585960616263646566676869
910
=>
"Unrecognised command"
,
);
my
$LF
=
"\x0A"
;
my
(
%options
,
%option_name
,
%commands
,
@aliases
,
@installables
,
%plugin_loaded
,
@plugins
,
);
run(
@ARGV
)
unless
caller
();
# Don't run anything if loaded via 'require'
sub
run {
App::BCVI->base_init();
App::BCVI->load_plugins();
App::BCVI->base_class()->process_command_line(
@_
);
exit
;
}
272273274275276277278279280281282283284285286287288289290291292sub
register_option {
my
$class
=
shift
;
my
$opt
= {
@_
};
my
$key
=
$opt
->{name};
if
(!
defined
$key
or !
length
$key
) {
die
"Can't register option without 'name'"
;
}
my
(
$package
,
$filename
,
$line
) =
caller
();
$opt
->{provider} =
"$package at $filename line $line"
;
my
$taken
=
$options
{
$key
};
if
(
$taken
&& !
$opt
->{force_override}) {
warn
"option '--$key' already registered by $taken->{provider}\n"
;
}
if
(
$opt
->{alias}) {
foreach
my
$a
(
map
{ s/^-+//;
$_
}
split
/\|/,
$opt
->{alias}) {
if
(
$option_name
{
$a
} && !
$opt
->{force_override}) {
if
(
$taken
=
$options
{
$option_name
{
$a
}}) {
warn
"alias '$a' already registered for option "
304305306307308309310311312313314315316317318319320321322323
my
$class
=
shift
;
my
$cmd
= {
@_
};
my
$key
=
$cmd
->{name};
if
(!
defined
$key
or !
length
$key
) {
die
"Can't register command without 'name'"
;
}
$cmd
->{dispatch_to} ||=
"execute_$key"
;
my
(
$package
,
$filename
,
$line
) =
caller
();
$cmd
->{provider} =
"$package at $filename line $line"
;
warn
"option '$key' already registered by $commands{$key}->{provider}\n"
if
$commands
{
$key
} && !
$cmd
->{force_override};
$commands
{
$key
} =
$cmd
;
}
sub
each_option {
my
(
$class
,
$sub
) =
@_
;
353354355356357358359360361362363364365366367368369370371372373sub
register_aliases {
my
$class
=
shift
;
push
@aliases
,
@_
;
}
sub
register_installable {
my
$class
=
shift
;
my
(
$package
,
$filename
,
$line
) =
caller
();
push
@installables
,
$filename
;
}
sub
shell_aliases {
my
(
$self
) =
@_
;
return
"## START-BCVI\n"
.
join
(
"\n"
,
map
{
" $_"
}
@aliases
)
397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429
die
qq{Error loading plugin "$file"\n$@\n}
}
$plugin_loaded
{
$key
} =
$file
;
}
sub
hook_client_class {
my
(
$class
) =
@_
;
my
(
$calling_class
,
$calling_file
) =
caller
();
my
$client_class
=
$class
->client_class();
$class
->map_class(
client
=>
$calling_class
);
no
strict
'refs'
;
unshift
@{
"${calling_class}::ISA"
},
$client_class
;
push
@plugins
, {
class
=>
$calling_class
,
file
=>
$calling_file
};
return
1;
}
sub
hook_server_class {
my
(
$class
) =
@_
;
my
(
$calling_class
,
$calling_file
) =
caller
();
my
$server_class
=
$class
->server_class();
$class
->map_class(
server
=>
$calling_class
);
no
strict
'refs'
;
unshift
@{
"${calling_class}::ISA"
},
$server_class
;
push
@plugins
, {
class
=>
$calling_class
,
file
=>
$calling_file
};
return
1;
}
( run in 0.244 second using v1.01-cache-2.11-cpan-a9ef4e587e4 )