libur-perl 0.430-1 / usr / share / perl5 / Command / V2Deprecated.pm

package Command::V2;  # additional methods to dispatch from a command-line
use strict;
use warnings;

sub sorted_sub_command_classes {
    no warnings;

    my @c = shift->sub_command_classes;
    my @commands_with_position = map { [ $_->sub_command_sort_position, $_ ] } @c;

    return map { $_->[1] }
           sort { ($a->[0] <=> $b->[0])
                    ||
                  ($a->[0] cmp $b->[0])
                }
           @commands_with_position;
}

sub sorted_sub_command_names {
    my $class = shift;
    my @sub_command_classes = $class->sorted_sub_command_classes;
    my @sub_command_names = map { $_->command_name_brief } @sub_command_classes;
    return @sub_command_names;
}

sub sub_commands_table {
    my $class = shift;
    my @sub_command_names = $class->sorted_sub_command_names;

    my $max_length = 0;
    for (@sub_command_names) {
        $max_length = length($_) if ($max_length < length($_));
    }
    $max_length ||= 79;
    my $col_spacer = '_'x$max_length;

    my $n_cols = floor(80/$max_length);
    my $n_rows = ceil(@sub_command_names/$n_cols);
    my @tb_rows;
    for (my $i = 0; $i < @sub_command_names; $i += $n_cols) {
        my $end = $i + $n_cols - 1;
        $end = $#sub_command_names if ($end > $#sub_command_names);
        push @tb_rows, [@sub_command_names[$i..$end]];
    }
    my @col_alignment;
    for (my $i = 0; $i < $n_cols; $i++) {
        push @col_alignment, { sample => "&$col_spacer" };
    }
    my $tb = Text::Table->new(@col_alignment);
    $tb->load(@tb_rows);
    return $tb;
}

sub help_sub_commands {
    my $class = shift;
    my %params = @_;
    my $command_name_method = 'command_name_brief';
    #my $command_name_method = ($params{brief} ? 'command_name_brief' : 'command_name');
    
    my @sub_command_classes = $class->sorted_sub_command_classes;

    my %categories;
    my @categories;
    for my $sub_command_class (@sub_command_classes) {
        my $category = $sub_command_class->sub_command_category;
        $category = '' if not defined $category;
        next if $sub_command_class->_is_hidden_in_docs();
        my $sub_commands_within_category = $categories{$category};
        unless ($sub_commands_within_category) {
            if (defined $category and length $category) {
                push @categories, $category;
            }
            else {
                unshift @categories,''; 
            }
            $sub_commands_within_category = $categories{$category} = [];
        }
        push @$sub_commands_within_category,$sub_command_class;
    }

    no warnings;
    local  $Text::Wrap::columns = 60;
    
    my $full_text = '';
    my @full_data;
    for my $category (@categories) {
        my $sub_commands_within_this_category = $categories{$category};
        my @data = map {
                my @rows = split("\n",Text::Wrap::wrap('', ' ', $_->help_brief));
                chomp @rows;
                (
                    [
                        $_->$command_name_method,
                        $_->_shell_args_usage_string_abbreviated,
                        $rows[0],
                    ],
                    map { 
                        [ 
                            '',
                            ' ',
                            $rows[$_],
                        ]
                    } (1..$#rows)
                );
            } 
            @$sub_commands_within_this_category;

        if ($category) {
            # add a space between categories
            push @full_data, ['','',''] if @full_data;

            if ($category =~ /\D/) {
                # non-numeric categories show their category as a header
                $category .= ':' if $category =~ /\S/;
                push @full_data, 
                    [
                        Term::ANSIColor::colored(uc($category), 'blue'),
                        '',
                        ''
                    ];

            }
            else {
                # numeric categories just sort
            }
        }

        push @full_data, @data;
    }

    my @max_width_found = (0,0,0);
    for (@full_data) {
        for my $c (0..2) {
            $max_width_found[$c] = length($_->[$c]) if $max_width_found[$c] < length($_->[$c]);
        }
    }

    my @colors = (qw/ red   bold /);
    my $text = '';
    for my $row (@full_data) {
        for my $c (0..2) {
            $text .= ' ';
            $text .= Term::ANSIColor::colored($row->[$c], $colors[$c]),
            $text .= ' ';
            $text .= ' ' x ($max_width_found[$c]-length($row->[$c]));
        }
        $text .= "\n";
    }
    #$DB::single = 1;        
    return $text;
}

sub sub_command_dirs {
    my $class = shift;
    my $subdir = ref($class) || $class;
    $subdir =~ s|::|\/|g;
    my @dirs = grep { -d $_ } map { $_ . '/' . $subdir  } @INC;
    return @dirs;
}

sub sub_command_classes {
    my $class = shift;
    my $mapping = $class->_build_sub_command_mapping;
    return values %$mapping;
}

sub _build_sub_command_mapping {
    my $class = shift;
    $class = ref($class) || $class;
    
    my $mapping;
    do {
        no strict 'refs';
        $mapping = ${ $class . '::SUB_COMMAND_MAPPING'};
    };
    
    unless (defined $mapping) {
        my $subdir = $class; 
        $subdir =~ s|::|\/|g;

        for my $lib (@INC) {
            my $subdir_full_path = $lib . '/' . $subdir;
            next unless -d $subdir_full_path;
            my @files = glob($subdir_full_path . '/*');
            next unless @files;
            for my $file (@files) {
                my $basename = basename($file);
                $basename =~ s/.pm$//;
                my $sub_command_class_name = $class . '::' . $basename;
                my $sub_command_class_meta = UR::Object::Type->get($sub_command_class_name);
                unless ($sub_command_class_meta) {
                    local $SIG{__DIE__};
                    local $SIG{__WARN__};
                    eval "use $sub_command_class_name";
                }
                $sub_command_class_meta = UR::Object::Type->get($sub_command_class_name);
                next unless $sub_command_class_name->isa("Command");
                next if $sub_command_class_meta->is_abstract;
                my $name = $class->_command_name_for_class_word($basename); 
                $mapping->{$name} = $sub_command_class_name;
            }
        }
    }
    return $mapping;
}

sub sub_command_names {
    my $class = shift;
    my $mapping = $class->_build_sub_command_mapping;
    return keys %$mapping;
}

sub class_for_sub_command
{
    my $self = shift;
    my $class = ref($self) || $self;
    my $sub_command = shift;


    return if $sub_command =~ /^\-/;

    my $sub_class = join("", map { ucfirst($_) } split(/-/, $sub_command));
    $sub_class = $class . "::" . $sub_class;

    my $meta = UR::Object::Type->get($sub_class); # allow in memory classes
    unless ( $meta ) {
        eval "use $sub_class;";
        if ($@) {
            if ($@ =~ /^Can't locate .*\.pm in \@INC/) {
                #die "Failed to find $sub_class! $class_for_sub_command.pm!\n$@";
                return;
            }
            else {
                my @msg = split("\n",$@);
                pop @msg;
                pop @msg;
                $self->error_message("$sub_class failed to compile!:\n@msg\n\n");
                return;
            }
        }
    }
    elsif (my $isa = $sub_class->isa("Command")) {
        if (ref($isa)) {
            # dumb modules (Test::Class) mess with the standard isa() API
            if ($sub_class->SUPER::isa("Command")) {
                return $sub_class;
            }
            else {
                return;
            }
        }
        return $sub_class;
    }
    else {
        return;
    }
}


1;


1;