view release on metacpan or  search on metacpan

lib/Badger/App.pm  view on Meta::CPAN

#    $self->{ app }->{ $self } = 'Hello World';
#    $self->debug("app: ", $self->dump_data($self->{ app }));
#    my $apps = $self->{ app }->{ apps } ||= [ ];
#    push(@$apps, $self);
    
    return $self;
}


sub init_options {
    my ($self, $config) = @_;
    my $options = $self->class->list_vars( OPTIONS => $config->{ options } );
    $self->{ schema } = $self->SCHEMA->new( schema => $options );
    $self->debug("created schema: ", $self->{ schema }) if DEBUG;
    return $self;
}


sub args {
    my $self    = shift->prototype;
    my $args    = @_ == 1 && ref $_[0] eq ARRAY ? shift : [ @_ ];
    my $options = $self->{ app }->{ options } ||= { };
    my ($arg, $option, $app);
    
    $self->debug("args(", $self->dump_data_inline($args), ")") if DEBUG;

    my $schema = $self->{ schema };
    $self->debug("using schema: $schema") if DEBUG;
    
    while (@$args) {
        $arg = $args->[0];
        $self->debug("option: $arg") if DEBUG;
        
        if ($option = $schema->item($arg)) {
            $self->debug("got schema option: $option") if DEBUG;
        }
        elsif ($arg =~ /^--(.*)/) {
            $self->debug("looking for option: $1") if DEBUG;
            # TODO: look up app stack
            $option = $schema->item($1)
                || return $self->error_msg( invalid => argument => $arg );
        }
        elsif ($arg =~ /^[\w\.]+$/ && ($app = $self->app($arg))) {
            shift @$args;
            return $app->new( 
                parent => $self,
                app    => $self->{ app } 
            )->args($args);
        }
        else {
            $self->debug("not found: $arg") if DEBUG;
            return $self->error_msg( invalid => argument => $arg );
        }

        shift @$args;
        $option->args($args, $self->{ app }, $self);
    }

    return $self;
#    $self->debug("options schema for this app is: ", $schema);
#    $self->not_implemented('in base class');
}


sub validate {
    my $self   = shift->prototype;
    my $app    = $self->{ app };
    my $schema = $self->{ schema };
    my ($item, $name);
    
    foreach $item ($schema->items) {
        next unless $item->{ required };
        $name = $item->{ name };
        return $self->error_msg( missing_arg => $name )
            unless defined $app->{ $name };
    }

    return $app;
}


sub app {
    shift->apps->app(@_);
}


sub apps {
    my $self = shift;

    return $self->{ apps } ||= do {
        my $class = $self->class;
        my $apps  = $class->hash_vars( 
            APPS => $self->{ config }->{ apps } 
        );
        my $path  = $class->list_vars( 
            APP_PATH => $self->{ config }->{ app_path }
        );
        push(@$path, $self->class->name) unless @$path;
        $self->debug(
            "creating app factory with path: ", $self->dump_data_inline($path),
            "and apps: ", $self->dump_data_inline($apps)
        ) if DEBUG;
        $self->APPS->new(
            path => $path,
            apps => $apps,
        );
    };
}


sub run {
    my $self = shift;
    $self->validate;
    $self->not_implemented('in base class');
}


#-----------------------------------------------------------------------
# output generation
#-----------------------------------------------------------------------

sub reporter {
    my $self   = shift->prototype;
    my $config = @_ ? params(@_) : $self->{ app };
    return $self->{ reporter }
       ||= class($self->REPORTER)->load->instance($config);
}


sub help {
    my $self = shift->prototype;
    $self->credits;
    $self->about;
    $self->usage;
    $self->options;
    exit;
}


sub credits {
    my $self = shift;
    $self->reporter->credits(
        $self->name, 
        $self->version, 
        $self->author, 
        $self->date,
    );
}


sub options {
    my $self     = shift->prototype;
    my $reporter = $self->reporter;
    $reporter->section('Options');

    foreach my $item ($self->{ schema }->items) {
        $item->summary($reporter);
    }
    return;

    my $options  = join(
        "\n  ", 
        grep { defined && length }
        map  { $_->summary } 
        $self->{ schema }->items
    ) || return '';
    
    $reporter->about($options);
}


sub blurb {
    my ($self, $type, $title) = @_;
    my $reporter = $self->reporter;