From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

THALJEF / Pinto-0.14 / lib / App / Pinto.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
—
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125

              
# ABSTRACT: Command-line driver for Pinto
package App::Pinto;
use strict;
use warnings;
use Class::Load;
use App::Cmd::Setup -app;
use Pinto::Util qw(is_remote_repo);
#------------------------------------------------------------------------------
our $VERSION = '0.14'; # VERSION
#------------------------------------------------------------------------------
sub global_opt_spec {
    return (
        [ 'root|r=s'           => 'Path to your repository root directory' ],
        [ 'color|colour!'      => 'Colorize any output (negatable)' ],
        [ 'password|p=s'       => 'Password for server authentication' ],
        [ 'quiet|q'            => 'Only report fatal errors' ],
        [ 'username|u=s'       => 'Username for server authentication' ],
        [ 'verbose|v+'         => 'More diagnostic output (repeatable)' ],
    );
}
#------------------------------------------------------------------------------
sub pinto {
    my ($self) = @_;
    return $self->{pinto} ||= do {
        my $global_options = $self->global_options;
        $global_options->{root} ||= $ENV{PINTO_REPOSITORY_ROOT}
            || $self->usage_error('Must specify a repository root');
        # Discard password and username arguments if this is not a
        # remote repository.  StrictConstrutor will not allow them.
        delete @{$global_options}{qw(username password)}
            if not is_remote_repo($global_options->{root});
        # Disable color if STDOUT is not a tty, unless it has already been
        # explicitly enabled. For example: pinto --color ls | less -R
        $global_options->{color} = 0 if ($ENV{PINTO_NO_COLOR} or not -t STDOUT)
            and not defined $global_options->{color};
        $global_options->{password} = $self->_prompt_for_password
            if defined $global_options->{password} and $global_options->{password} eq '-';
        my $pinto_class = $self->pinto_class_for( $global_options->{root} );
        Class::Load::load_class($pinto_class);
        $pinto_class->new( %{$global_options} );
    };
}
#------------------------------------------------------------------------------
sub pinto_class_for {
    my ( $self, $root ) = @_;
    return is_remote_repo($root) ? 'Pinto::Remote' : 'Pinto';
}
#------------------------------------------------------------------------------
sub _prompt_for_password {
    my ($self) = @_;
    require Encode;
    require IO::Prompt;
    my $repo     = $self->global_options->{root};
    my $prompt   = "Password for repository at $repo: ";
    my $input    = IO::Prompt::prompt( $prompt, -echo => '*', -tty );
    my $password = Encode::decode_utf8($input);
    return $password;
}
#-------------------------------------------------------------------------------
1;
__END__
=pod
=encoding UTF-8
=for :stopwords Jeffrey Ryan Thalhammer
=head1 NAME
App::Pinto - Command-line driver for Pinto
=head1 VERSION
version 0.14
=head1 SYNOPSIS
L<pinto> to create and manage a Pinto repository.
L<pintod> to allow remote access to your Pinto repository.
L<Pinto::Manual> for general information on using Pinto.
L<Stratopan|http://stratopan.com> for hosting your Pinto repository in the cloud.
=head1 AUTHOR
Jeffrey Ryan Thalhammer <jeff@stratopan.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015 by Jeffrey Ryan Thalhammer.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut