Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

* Created Plumage::Command class for representing commands as it will…

… be needed soon by Plumage::Interactive.

* Modified %COMMANDS to make use of new class.
* Added skeleton for docs/interactive.pod which will describe how to use CLI interface.
* Made various code cleanups and added verbosity to inline comments.
  • Loading branch information...
commit c5167cad921b9dab25f9feff120e6984f04a7c2d 1 parent 8ed312e
@soh-cah-toa soh-cah-toa authored
View
3  docs/interactive.pod
@@ -0,0 +1,3 @@
+=begin pod
+
+=end pod
View
122 setup.pir
@@ -19,77 +19,89 @@ No Configure step, no Makefile generated.
.sub 'main' :main
.param pmc args
+
$S0 = shift args
load_bytecode 'distutils.pbc'
+
.local pmc config
config = get_config()
- .const 'Sub' selfinstall = 'selfinstall'
- register_step('selfinstall', selfinstall)
-
- $P0 = new 'Hash'
- $P0['name'] = 'Plumage'
- $P0['abstract'] = 'Parrot Plumage is the Parrot module ecosystem'
- $P0['authority'] = 'http://github.com/parrot'
- $P0['description'] = 'Parrot Plumage is the Parrot module ecosystem. It includes tools to search metadata, handle dependencies, install modules, and so forth.'
- $P1 = split ',', 'parrot package deployment module ecosystem'
- $P0['keywords'] = $P1
- $P0['license_type'] = 'Artistic License 2.0'
- $P0['license_uri'] = 'http://www.perlfoundation.org/artistic_license_2_0'
- $P0['copyright_holder'] = 'Parrot Foundation'
- $P0['checkout_uri'] = 'git://github.com/parrot/plumage.git'
- $P0['browser_uri'] = 'http://github.com/parrot/plumage'
- $P0['project_uri'] = 'https://trac.parrot.org/parrot/wiki/ModuleEcosystem'
-
- # build
- $P2 = new 'Hash'
- $P2['src/lib/Plumage/Dependencies.pir'] = 'src/lib/Plumage/Dependencies.nqp'
- $P2['src/lib/Plumage/Metadata.pir'] = 'src/lib/Plumage/Metadata.nqp'
- $P2['src/lib/Plumage/Project.pir'] = 'src/lib/Plumage/Project.nqp'
- $P2['src/lib/Plumage/Util.pir'] = 'src/lib/Plumage/Util.nqp'
- $P2['src/lib/Plumage/NQPUtil.pir'] = 'src/lib/Plumage/NQPUtil.nqp'
- $P2['src/plumage.pir'] = 'src/plumage.nqp'
- $P0['pir_nqp'] = $P2
-
- $P3 = new 'Hash'
- $P3['Plumage/Dependencies.pbc'] = 'src/lib/Plumage/Dependencies.pir'
- $P3['Plumage/Metadata.pbc'] = 'src/lib/Plumage/Metadata.pir'
- $P3['Plumage/Project.pbc'] = 'src/lib/Plumage/Project.pir'
- $P3['Plumage/Util.pbc'] = 'src/lib/Plumage/Util.pir'
- $P3['Plumage/NQPUtil.pbc'] = 'src/lib/Plumage/NQPUtil.pir'
- $P3['plumage.pbc'] = 'src/plumage.pir'
- $P0['pbc_pir'] = $P3
-
- $P4 = new 'Hash'
- $P4['plumage'] = 'plumage.pbc'
+ .const 'Sub' selfinstall = 'selfinstall'
+ register_step('selfinstall', selfinstall)
+
+ $S1 = 'Plumage is a package manager for the Parrot VM module ecosystem. '
+ $S1 .= 'With it, you can perform tasks such as searching, installing, and '
+ $S1 .= 'testing modules in the ecosystem.'
+
+ $P0 = new 'Hash'
+ $P0['name'] = 'Plumage'
+ $P0['abstract'] = 'Plumage is a package manager for the Parrot VM module ecosystem.'
+ $P0['authority'] = 'http://github.com/parrot'
+ $P0['description'] = $S1
+ $P1 = split ',', 'parrot package deployment module ecosystem'
+ $P0['keywords'] = $P1
+ $P0['license_type'] = 'Artistic License 2.0'
+ $P0['license_uri'] = 'http://www.perlfoundation.org/artistic_license_2_0'
+ $P0['copyright_holder'] = 'Parrot Foundation'
+ $P0['checkout_uri'] = 'git://github.com/parrot/plumage.git'
+ $P0['browser_uri'] = 'https://github.com/parrot/plumage'
+ $P0['project_uri'] = 'https://trac.parrot.org/parrot/wiki/ModuleEcosystem'
+
+ # Build
+ $P2 = new 'Hash'
+ $P2['src/lib/Plumage/Dependencies.pir'] = 'src/lib/Plumage/Dependencies.nqp'
+ $P2['src/lib/Plumage/Metadata.pir'] = 'src/lib/Plumage/Metadata.nqp'
+ $P2['src/lib/Plumage/Project.pir'] = 'src/lib/Plumage/Project.nqp'
+ $P2['src/lib/Plumage/Util.pir'] = 'src/lib/Plumage/Util.nqp'
+ $P2['src/lib/Plumage/NQPUtil.pir'] = 'src/lib/Plumage/NQPUtil.nqp'
+ $P2['src/lib/Plumage/Interactive.pir'] = 'src/lib/Plumage/Interactive.nqp'
+ $P2['src/lib/Plumage/Command.pir'] = 'src/lib/Plumage/Command.nqp'
+ $P2['src/plumage.pir'] = 'src/plumage.nqp'
+ $P0['pir_nqp'] = $P2
+
+ $P3 = new 'Hash'
+ $P3['Plumage/Dependencies.pbc'] = 'src/lib/Plumage/Dependencies.pir'
+ $P3['Plumage/Metadata.pbc'] = 'src/lib/Plumage/Metadata.pir'
+ $P3['Plumage/Project.pbc'] = 'src/lib/Plumage/Project.pir'
+ $P3['Plumage/Util.pbc'] = 'src/lib/Plumage/Util.pir'
+ $P3['Plumage/NQPUtil.pbc'] = 'src/lib/Plumage/NQPUtil.pir'
+ $P3['Plumage/Interactive.pbc'] = 'src/lib/Plumage/Interactive.pir'
+ $P3['Plumage/Command.pbc'] = 'src/lib/Plumage/Command.pir'
+ $P3['plumage.pbc'] = 'src/plumage.pir'
+ $P0['pbc_pir'] = $P3
+
+ $P4 = new 'Hash'
+ $P4['plumage'] = 'plumage.pbc'
$P0['installable_pbc'] = $P4
- # test
- $S0 = get_nqp_rx()
+ # Test
+ $S0 = get_nqp_rx()
$P0['prove_exec'] = $S0
- # smoke
+ # Smoke test
$P0['prove_archive'] = 'test_plumage.tar.gz'
- $P0['smolder_url'] = 'http://smolder.parrot.org/app/projects/process_add_report/3'
-# $P0['smolder_comments'] = 'plumage'
- $S0 = get_tags(config)
- $P0['smolder_tags'] = $S0
+ $P0['smolder_url'] = 'http://smolder.parrot.org/app/projects/process_add_report/3'
+ $S0 = get_tags(config)
+ $P0['smolder_tags'] = $S0
- # install
+ # Install
$P5 = split "\n", <<'LIBS'
Plumage/Dependencies.pbc
Plumage/Metadata.pbc
Plumage/Project.pbc
Plumage/Util.pbc
Plumage/NQPUtil.pbc
+Plumage/Interactive.pbc
+Plumage/Command.pbc
LIBS
- $S0 = pop $P5
- $P0['inst_lib'] = $P5
- $P6 = glob('plumage/metadata/*.json')
+
+ $S0 = pop $P5
+ $P0['inst_lib'] = $P5
+ $P6 = glob('plumage/metadata/*.json')
$P0['inst_data'] = $P6
- # dist
- $P7 = glob('CREDITS README TASKS TODO docs/*/*.pod')
+ # Distribution
+ $P7 = glob('CREDITS README TASKS TODO docs/*/*.pod')
$P0['doc_files'] = $P7
.tailcall setup(args :flat, $P0 :flat :named)
@@ -97,20 +109,22 @@ LIBS
.sub 'selfinstall' :anon
.param pmc kv :slurpy :named
+
system('parrot plumage.pbc install plumage', 1 :named('verbose'))
.end
.sub 'get_tags'
.param pmc config
+
.local string tags
- tags = config['osname']
+ tags = config['osname']
tags .= ", "
- $S0 = config['archname']
+ $S0 = config['archname']
tags .= $S0
+
.return (tags)
.end
-
# Local Variables:
# mode: pir
# fill-column: 100
View
62 src/lib/Plumage/Command.nqp
@@ -0,0 +1,62 @@
+# Copyright (C) 2011, Parrot Foundation.
+
+=begin pod
+
+=head1 NAME
+
+Plumage::Command - represents a Plumage command
+
+=head1 SYNOPSIS
+
+ # Load library
+ pir::load_bytecode('Plumage/Command.pbc')
+
+ # Class methods
+ my $help_cmd := Plumage::Command.new(:action(command_help),
+ :args('opt_command'),
+ :usage('help [<command>]'),
+ :help('Displays a help message on command usage.')),
+
+ # Accessors
+ my $help_cmd.action;
+ my $help_cmd.args;
+ my $help_cmd.usage;
+ my $help_cmd.help;
+
+=head1 DESCRIPTION
+
+The C<Plumage::Command> class is an abstract representation of a Plumage
+command.
+
+=end pod
+
+class Plumage::Command;
+
+has $!action; # Subroutine to execute
+has $!args; # Type of argument(s) command takes
+has $!usage; # Describes semantics of command usage
+has $!help; # Describes purpose of command in more detail
+
+method new(:$action, :$args, :$usage, :$help) {
+ my $class := pir::getattribute__PPs(self.HOW, "parrotclass");
+
+ Q:PIR {
+ $P0 = find_lex '$class'
+ self = new $P0
+ };
+
+ $!action := $action;
+ $!args := $args;
+ $!usage := $usage;
+ $!help := $help;
+
+ return self;
+}
+
+# Accessors
+method action() { return $!action }
+method args() { return $!args }
+method usage() { return $!usage }
+method help() { return $!help }
+
+# vim: ft=perl6
View
50 src/lib/Plumage/Interactive.nqp
@@ -0,0 +1,50 @@
+# Copyright (C) 2011, Parrot Foundation.
+
+=begin pod
+
+=head1 NAME
+
+Plumage::Interactive - manages an interactive session
+
+=head1 SYNOPSIS
+
+ # Load library
+ pir::load_bytecode('Plumage/Interactive.pbc')
+
+ my $session := Plumage::Interactive.new;
+
+=head1 DESCRIPTION
+
+The C<Plumage::Interactive> class handles all the tasks of managing an
+interactive session. For example, prompting for commands, .
+
+=end pod
+
+class Plumage::Interactive;
+
+method new(:$action, :$args, :$usage, :$help) {
+ my $class := pir::getattribute__PPs(self.HOW, "parrotclass");
+
+ Q:PIR {
+ $P0 = find_lex '$class'
+ self = new $P0
+ };
+
+ self.welcome();
+
+ return self;
+}
+
+method prompt(Str $msg) {
+ return pir::getstdin__P().readline_interactive("$msg> ");
+}
+
+method welcome() {
+ say("Plumage: Package Manager for Parrot\n"
+ ~ "Copyright (C) 2009-2011, Parrot Foundation.\n\n"
+
+ ~ "Enter 'h' or 'help' for help or see docs/interactive.pod "
+ ~ "for further information\n");
+}
+
+# vim: ft=perl6
View
30 src/lib/Plumage/Metadata.nqp
@@ -53,7 +53,7 @@ passing to C<$meta.find_by_project_name()> to obtain more details.
=end
-method get_project_list () {
+method get_project_list() {
my @files := $*OS.readdir(replace_config_strings(%*CONF<plumage_metadata_dir>));
my $regex := /\.json$/;
my @projects;
@@ -79,7 +79,7 @@ location for Plumage metadata files.
=end
-method exists ($dir?) {
+method exists($dir?) {
return path_exists(self.project_metadata_path($dir));
}
@@ -94,7 +94,7 @@ the C<$path> will be the generic default location relative to a project root.
=end
-method project_metadata_path ($dir?) {
+method project_metadata_path($dir?) {
my @dir := pir::length($dir) ?? [$dir, 'plumage']
!! [ 'plumage'];
my $path := fscat(@dir, 'metadata.json');
@@ -136,9 +136,9 @@ has %!metadata;
has $!valid;
has $!error;
-method is_valid () { ?$!valid }
-method error () { $!error }
-method metadata () { %!metadata }
+method is_valid() { ?$!valid }
+method error() { $!error }
+method metadata() { %!metadata }
=begin
@@ -160,7 +160,7 @@ C<get_project_list>.
=end
-method find_by_project_name ($project_name) {
+method find_by_project_name($project_name) {
my $meta_dir := replace_config_strings(%*CONF<plumage_metadata_dir>);
my $meta_file := fscat([$meta_dir], "$project_name.json");
@@ -183,7 +183,7 @@ C<project_metadata_path>).
=end
-method load_from_project_dir ($dir) {
+method load_from_project_dir($dir) {
return self.load_from_file(self.project_metadata_path($dir));
}
@@ -195,7 +195,7 @@ Load and parse a particular metadata file.
=end
-method load_from_file ($path) {
+method load_from_file($path) {
%!metadata := Config::JSON::ReadConfig($path);
return self.validate;
@@ -227,7 +227,7 @@ method load_from_string($serialized) {
}
}
-method validate () {
+method validate() {
$!valid := %!metadata
&& self.metadata_spec_known
&& self.metadata_instruction_types_known;
@@ -237,7 +237,7 @@ method validate () {
return $!valid;
}
-method metadata_spec_known () {
+method metadata_spec_known() {
my %spec := %!metadata<meta-spec>;
my $known_uri := 'https://trac.parrot.org/parrot/wiki/ModuleEcosystem';
my $known_version := 1;
@@ -268,7 +268,7 @@ method metadata_spec_known () {
return 0;
}
-method metadata_instruction_types_known () {
+method metadata_instruction_types_known() {
my %inst := %!metadata<instructions>;
unless %inst && %inst.keys {
@@ -317,7 +317,7 @@ Return the file path for the metadata copy saved after install.
=end
-method saved_copy_path () {
+method saved_copy_path() {
my $meta_root := _saved_copy_root();
my $copy_path := fscat([$meta_root],
pir::downcase(%!metadata<general><name>) ~ '.json');
@@ -339,7 +339,7 @@ installed.
=end
-method save_install_copy () {
+method save_install_copy() {
mkpath(_saved_copy_root());
Config::JSON::WriteConfig(%!metadata, self.saved_copy_path);
@@ -354,7 +354,7 @@ because the associated project was successfully uninstalled.
=end
-method remove_install_copy () {
+method remove_install_copy() {
my $path := self.saved_copy_path;
$*OS.rm($path) if path_exists($path);
View
4 src/lib/Plumage/Util.nqp
@@ -48,7 +48,7 @@ producing unintended expansions.
=end
-sub replace_config_strings ($original) {
+sub replace_config_strings($original) {
my $new := $original;
repeat {
@@ -60,7 +60,7 @@ sub replace_config_strings ($original) {
return $new;
}
-sub config_value ($match) {
+sub config_value($match) {
my $key := $match<ident>;
my $config := %*CONF{$key}
|| %*VM<config>{$key}
View
397 src/plumage.nqp
@@ -1,10 +1,8 @@
# Copyright (C) 2009-2011, Parrot Foundation.
-###
-### NQP WORKAROUND HACKS
-###
+# TODO Add perldoc
-# Must declare all 'setting globals' here, because NQP doesn't know about them
+# Global setting variables (NQP workaround)
my $*PROGRAM_NAME;
my $*OSNAME;
my @*ARGS;
@@ -12,131 +10,124 @@ my %*ENV;
my %*VM;
my $*OS;
-# NQP does not include a setting, so must load helper libraries first
-load_helper_libraries();
+load_libraries();
-# NQP does not have full {...} hash syntax, so use hash() and named args
+# Global structure of recognized commands
my %COMMANDS := hash(
- usage => hash(
- action => command_usage,
- args => 'none',
- usage => 'usage',
- help => 'This command is here for compatibility purposes. Please use `help` instead.'
- ),
- help => hash(
- action => command_help,
- args => 'opt_command',
- usage => 'help [<command>]',
- help => 'Print a helpful usage message.'
- ),
- version => hash(
- action => command_version,
- args => 'none',
- usage => 'version',
- help => 'Print program version and copyright.',
- ),
- projects => hash(
- action => command_projects,
- args => 'none',
- usage => 'projects',
- help => 'List all known projects.'
- ),
- status => hash(
- action => command_status,
- args => 'opt_project',
- usage => 'status [<project>]',
- help => 'Show status of projects (defaults to all).'
- ),
- info => hash(
- action => command_info,
- args => 'project',
- usage => 'info <project>',
- help => 'Print summary about a particular project.'
- ),
- metadata => hash(
- action => command_info,
- args => 'project',
- usage => 'metadata <project>',
- help => 'Print JSON metadata about a particular project.'
- ),
- project_dir => hash(
- action => command_project_dir,
- args => 'project',
- usage => 'project-dir <project>',
- help => 'Print project\'s top directory'
- ),
- showdeps => hash(
- action => command_showdeps,
- args => 'project',
- usage => 'showdeps <project>',
- help => 'Show dependency resolution for a project.'
- ),
- fetch => hash(
- action => command_project_action,
- args => 'project',
- usage => 'fetch <project>',
- help => 'Download source.'
- ),
- update => hash(
- action => command_project_action,
- args => 'project',
- usage => 'update <project>',
- help => 'Update source (falls back to fetch).'
- ),
- configure => hash(
- action => command_project_action,
- args => 'project',
- usage => 'configure <project>',
- help => 'Configure source (updates first).'
- ),
- build => hash(
- action => command_project_action,
- args => 'project',
- usage => 'build <project>',
- help => 'Build project from source (configures first).'
- ),
- test => hash(
- action => command_project_action,
- args => 'project',
- usage => 'test <project>',
- help => 'Test built project (builds first).'
- ),
- smoke => hash(
- action => command_project_action,
- args => 'project',
- usage => 'smoke <project>',
- help => 'Smoke test project (builds first).'
- ),
- install => hash(
- action => command_project_action,
- args => 'project',
- usage => 'install <project>',
- help => 'Install built files (tests first).'
- ),
- uninstall => hash(
- action => command_project_action,
- args => 'project',
- usage => 'uninstall <project>',
- help => 'Uninstalls installed files (not always available).'
- ),
- clean => hash(
- action => command_project_action,
- args => 'project',
- usage => 'clean <project>',
- help => 'Clean source tree.'
- ),
- realclean => hash(
- action => command_project_action,
- args => 'project',
- usage => 'realclean <project>',
- help => 'Clobber/realclean source tree.'
- ),
-);
-
-# Work around NQP limitation with key names on the left of =>
-# (and as a side benefit, support both spellings)
+ usage => Plumage::Command.new(:action(command_usage),
+ :args('none'),
+ :usage('usage'),
+ :help('This command is here for compatibility '
+ ~ 'only. Please use `help` instead.')),
+
+ interactive => Plumage::Command.new(:action(command_interactive),
+ :args('none'),
+ :usage(''),
+ :help('')),
+
+ help => Plumage::Command.new(:action(command_help),
+ :args('opt_command'),
+ :usage('help [<command>]'),
+ :help('Displays a help message on command usage.')),
+
+ version => Plumage::Command.new(:action(command_version),
+ :args('none'),
+ :usage('version'),
+ :help('Displays Plumage version and copyright statement.')),
+
+ projects => Plumage::Command.new(:action(command_projects),
+ :args('none'),
+ :usage('projects'),
+ :help('Lists all known projects.')),
+
+ status => Plumage::Command.new(:action(command_status),
+ :args('opt_project'),
+ :usage('status <project>'),
+ :help('Displays status of <project> (defaults to all).')),
+
+ info => Plumage::Command.new(:action(command_info),
+ :args('project'),
+ :usage('info <project>'),
+ :help('Displays detailed description of <project>.')),
+
+ metadata => Plumage::Command.new(:action(command_info),
+ :args('project'),
+ :usage('metadata <project>'),
+ :help('Displays JSON metadata for <project>.')),
+
+ project_dir => Plumage::Command.new(:action(command_project_dir),
+ :args('project'),
+ :usage('project-dir <project>'),
+ :help('Displays top directory for <project>.')),
+
+ show_deps => Plumage::Command.new(:action(command_show_deps),
+ :args('project'),
+ :usage('show-deps <project>'),
+ :help('Shows dependencies for <project>.')),
+
+ fetch => Plumage::Command.new(:action(command_project_action),
+ :args('project'),
+ :usage('fetch <project>'),
+ :help('Downloads source code for <project>.')),
+
+ update => Plumage::Command.new(:action(command_project_action),
+ :args('project'),
+ :usage('update <project>'),
+ :help('Updates source code for <project> '
+ ~ '(falls back to "fetch").')),
+
+ configure => Plumage::Command.new(:action(command_project_action),
+ :args('project'),
+ :usage('configure <project>'),
+ :help('Configures source code for <project> '
+ ~ '(runs "update" first).')),
+
+ build => Plumage::Command.new(:action(command_project_action),
+ :args('project'),
+ :usage('build <project>'),
+ :help('Builds <project> in current directory '
+ ~ '(runs "configure" first).')),
+
+ test => Plumage::Command.new(:action(command_project_action),
+ :args('project'),
+ :usage('test <project>'),
+ :help('Runs test suite for <project> '
+ ~ '(runs "build" first).')),
+
+ smoke => Plumage::Command.new(:action(command_project_action),
+ :args('project'),
+ :usage('smoke <project>'),
+ :help('Runs test suite for <project> and sends '
+ ~ 'results to Parrot\'s Smolder server '
+ ~ '(runs "build" first).')),
+
+ install => Plumage::Command.new(:action(command_project_action),
+ :args('project'),
+ :usage('install <project>'),
+ :help('Installs <project> (runs "test" first).')),
+
+ uninstall => Plumage::Command.new(:action(command_project_action),
+ :args('project'),
+ :usage('uninstall <project>'),
+ :help('Uninstalls <project> from system '
+ ~ '(not always available).')),
+
+ clean => Plumage::Command.new(:action(command_project_action),
+ :args('project'),
+ :usage('clean <project>'),
+ :help('Performs basic clean up of source tree.')),
+
+ realclean => Plumage::Command.new(:action(command_project_action),
+ :args('project'),
+ :usage('realclean <project>'),
+ :help('Removes all files generated during the '
+ ~ 'build process.')));
+
+# Add support for both spellings of certain commands
%COMMANDS<project-dir> := %COMMANDS<project_dir>;
+%COMMANDS<show-deps> := %COMMANDS<show_deps>;
+# Default configuration
my %DEFAULT_CONF := hash(
parrot_user_root => '#user_home_dir#/.parrot',
plumage_user_root => '#parrot_user_root#/plumage',
@@ -151,53 +142,66 @@ unless path_exists(%DEFAULT_CONF<plumage_metadata_dir>) {
%DEFAULT_CONF<plumage_metadata_dir> := %*VM<config><datadir> ~ '/plumage/metadata';
}
-# NQP does not automatically call MAIN()
MAIN();
###
-### INIT
+### INITIALIZATION
+###
+### The following subroutines perform the various tasks that need to be
+### performed before any commands are executed such as loading libraries,
+### parsing command-line options, and reading the config file
###
-our %OPT;
+# XXX Why is this package-scoped? Can it be declared with 'my'?
+our %OPTIONS; # Command-line switches
-my %*CONF;
-my %*BIN;
+my %*CONF; # Configuration options
+my %*BIN; # System binaries
-sub load_helper_libraries() {
- # Support OO
+sub load_libraries() {
+ # Object-oriented interface
pir::load_bytecode('P6object.pbc');
- # Process command line options
+ # Processes command-line switches
pir::load_bytecode('Getopt/Obj.pbc');
- # Parse files in JSON format
+ # Parses JSON config files
pir::load_bytecode('Config/JSON.pbc');
- # Data structure dumper for PMCs (used for debugging)
+ # "Stringifies" PMC data structures (used for debugging only)
pir::load_bytecode('dumper.pbc');
- # Utility functions and standard "globals"
+ # Extends NQP runtime environment and native data structures
pir::load_bytecode('Plumage/NQPUtil.pbc');
- # Plumage modules: util, metadata, project, dependencies
+ # Provides subroutines needed to replace config strings
pir::load_bytecode('Plumage/Util.pbc');
+
+ # Parses a project's metadata
pir::load_bytecode('Plumage/Metadata.pbc');
+
+ # Represents a project and performs certain actions on them
pir::load_bytecode('Plumage/Project.pbc');
+
+ # Resolves dependencies
pir::load_bytecode('Plumage/Dependencies.pbc');
+
+ # Represents Plumage commands
+ pir::load_bytecode('Plumage/Command.pbc');
}
sub parse_command_line_options() {
- my $getopts := pir::root_new__PP(< parrot Getopt Obj >);
+ my $getopt := pir::root_new__PP(< parrot Getopt Obj >);
# Configure -c switch
- my $config := $getopts.add();
+ my $config := $getopt.add();
$config.name('CONFIG_FILE');
$config.long('config-file');
$config.short('c');
$config.type('String');
# Configure -i switch
- my $ignore := $getopts.add();
+ my $ignore := $getopt.add();
$ignore.name('IGNORE_FAIL');
$ignore.long('ignore-fail');
$ignore.short('i');
@@ -205,17 +209,16 @@ sub parse_command_line_options() {
$ignore.optarg(1);
# Configure -h switch
- my $help := $getopts.add();
+ my $help := $getopt.add();
$help.name('HELP');
$help.long('help');
$help.short('h');
- # Parse @*ARGS
- %OPT := $getopts.get_options(@*ARGS);
+ %OPTIONS := $getopt.get_options(@*ARGS);
}
sub read_config_files() {
- # Find config files for this system and user (ignored if missing).
+ # Find config file for this system and user (if any)
my $etc := %*VM<conf><sysconfdir>;
my $home := %*ENV<PLUMAGE_HOME> || user_home_dir();
my $base := 'plumage.json';
@@ -223,12 +226,12 @@ sub read_config_files() {
my $userconf := fscat([$home, 'parrot', 'plumage'], $base);
my @configs := ($sysconf, $userconf);
- # Remember home dir, we'll need that later
+ # Remember home directory
%*CONF<user_home_dir> := $home;
- # If another config specified via command line option, add it. Because
- # this was manually set by the user, it is a fatal error if missing.
- my $optconf := %OPT<CONFIG_FILE>;
+ # Use config file given on command-line, if given
+ my $optconf := %OPTIONS<CONFIG_FILE>;
+
if $optconf {
if path_exists($optconf) {
@configs.push($optconf);
@@ -238,7 +241,7 @@ sub read_config_files() {
}
}
- # Merge together default, system, user, and option configs
+ # Merge together 'default', 'system', 'user', and 'option' config options
%*CONF := merge_tree_structures(%*CONF, %DEFAULT_CONF);
for @configs -> $config {
@@ -247,7 +250,7 @@ sub read_config_files() {
%*CONF := merge_tree_structures(%*CONF, %conf);
CATCH {
- say("Could not parse JSON file '$config'.");
+ say("Could not parse config file '$config'.");
}
}
}
@@ -258,9 +261,9 @@ sub merge_tree_structures($dst, $src) {
my $d := $dst{$k};
my $s := $src{$k};
- if $d && pir::does__IPs($d, 'hash')
- && $s && pir::does__IPs($s, 'hash') {
- $dst{$k} := merge_tree_structures($d, $s);
+ if $d && pir::does__IPs($d, 'hash')
+ && $s && pir::does__IPs($s, 'hash') {
+ $dst{$k} := merge_tree_structures($d, $s);
}
else {
$dst{$k} := $s;
@@ -274,51 +277,33 @@ sub find_binaries() {
my %conf := %*VM<config>;
my $parrot_bin := %conf<bindir>;
- # Parrot programs; must be sourced from configured parrot bin directory
+ # Parrot binaries (must be sourced from configured Parrot bin directory)
%*BIN<parrot_config> := fscat([$parrot_bin], 'parrot_config');
%*BIN<parrot-nqp> := fscat([$parrot_bin], 'parrot-nqp');
%*BIN<parrot> := fscat([$parrot_bin], 'parrot');
- # Programs used to build parrot; make sure we use the same ones
- %*BIN<perl5> := %conf<perl>;
- %*BIN<make> := %conf<make>;
-
- # Unrelated system programs; look for them in the user's search path
- %*BIN<rake> := find_program('rake');
- %*BIN<svn> := find_program('svn');
- %*BIN<git> := find_program('git');
- %*BIN<hg> := find_program('hg');
-}
+ # Use the same programs used to build Parrot
+ %*BIN<perl5> := %conf<perl>;
+ %*BIN<make> := %conf<make>;
-###
-### MAIN
-###
-
-sub MAIN() {
- parse_command_line_options();
- read_config_files();
- find_binaries();
-
- if %OPT.exists('HELP') {
- execute_command('help');
- }
- else {
- my $command := parse_command_line();
- execute_command($command);
- }
+ # Additional programs needed to fetch project's source code
+ %*BIN<rake> := find_program('rake');
+ %*BIN<svn> := find_program('svn');
+ %*BIN<git> := find_program('git');
+ %*BIN<hg> := find_program('hg');
}
sub parse_command_line() {
- my $command := @*ARGS ?? @*ARGS.shift !! 'help';
+ my $command := @*ARGS ?? @*ARGS.shift !! 'interactive';
return $command;
}
sub execute_command($command) {
- my $action := %COMMANDS{$command}<action>;
- my $args := %COMMANDS{$command}<args>;
+ my $action := %COMMANDS{$command}.action;
+ my $args := %COMMANDS{$command}.args;
- if ($action) {
+ if $action {
if $args eq 'project' && !@*ARGS {
say('Please specify a project to act on.');
}
@@ -329,7 +314,7 @@ sub execute_command($command) {
}
}
else {
- say("I don't know how to '$command'!");
+ say("No such command: $command. Please use $*PROGRAM_NAME --help");
pir::exit(1);
}
}
@@ -337,6 +322,9 @@ sub execute_command($command) {
###
### COMMANDS
###
+### Each of the following subroutines represents an individual command recognized
+### by Plumage (note the command_* prefix followed by the actual command name)
+###
sub command_usage() {
print(usage_info());
@@ -389,8 +377,8 @@ Commands:
sub command_help($help_cmd, :$command) {
if ?$help_cmd {
- my $usage := %COMMANDS{$help_cmd[0]}<usage>;
- my $help := %COMMANDS{$help_cmd[0]}<help>;
+ my $usage := %COMMANDS{$help_cmd[0]}.usage;
+ my $help := %COMMANDS{$help_cmd[0]}.help;
say("$usage\n");
say($help);
@@ -400,6 +388,16 @@ sub command_help($help_cmd, :$command) {
}
}
+sub command_interactive() {
+ pir::load_bytecode('Plumage/Interactive.pbc');
+
+ my $session := Plumage::Interactive.new;
+
+ my $command := $session.prompt('plumage');
+
+ say("COMMAND: $command");
+}
+
sub command_version() {
print(version_info());
}
@@ -451,7 +449,7 @@ sub command_status(@projects, :$command) {
unless @projects {
@projects := Plumage::Metadata.get_project_list();
- say("\nKnown projects:\n");
+ say("Known projects:\n");
}
my @installed := Plumage::Dependencies.get_installed_projects();
@@ -489,7 +487,7 @@ sub command_info(@projects, :$command) {
}
}
-sub command_showdeps(@projects, :$command) {
+sub command_show_deps(@projects, :$command) {
unless (@projects) {
say('Please include the name of the project to show dependencies for.');
}
@@ -567,7 +565,7 @@ sub show_dependencies(@projects) {
say("Missing and unrecognized: $need_unknown");
if $need_unknown {
- # XXXX: Don't forget to fix this when metadata is retrieved from server
+ # XXX Don't forget to fix this when metadata is retrieved from server
say("\nI don't recognize some of these dependencies. First, update and\n"
~ "rebuild Plumage to get the latest metadata. Next, please check\n"
@@ -590,12 +588,13 @@ sub show_dependencies(@projects) {
}
sub perform_actions_on_projects(@projects, :$up_to, :@actions) {
- my $has_ignore_flag := %OPT.exists('IGNORE_FAIL');
- my %ignore := %OPT<IGNORE_FAIL>;
+ my $has_ignore_flag := %OPTIONS.exists('IGNORE_FAIL');
+ my %ignore := %OPTIONS<IGNORE_FAIL>;
my $ignore_all := $has_ignore_flag && !%ignore;
for @projects -> $project_name {
my $project := Plumage::Project.new($project_name);
+
if pir::defined__IP($project) {
return 0 unless $project.perform_actions(:up_to($up_to),
:actions(@actions),
@@ -627,4 +626,18 @@ sub print_project_summary($meta) {
say(pir::sprintf__SsP("%-11s : %s", ["Description", $description]));
}
+sub MAIN() {
+ parse_command_line_options();
+ read_config_files();
+ find_binaries();
+
+ if %OPTIONS.exists('HELP') {
+ execute_command('help');
+ }
+ else {
+ my $command := parse_command_line();
+ execute_command($command);
+ }
+}
+
# vim: ft=perl6
Please sign in to comment.
Something went wrong with that request. Please try again.