File Coverage

blib/lib/Group/Git/Stash.pm
Criterion Covered Total %
statement 30 98 30.6
branch 0 36 0.0
condition 0 14 0.0
subroutine 10 13 76.9
pod n/a
total 40 161 24.8


line stmt bran cond sub pod time code
1             package Group::Git::Stash;
2              
3             # Created on: 2013-05-04 20:18:24
4             # Create by: Ivan Wills
5             # $Id$
6             # $Revision$, $HeadURL$, $Date$
7             # $Revision$, $Source$, $Date$
8              
9 1     1   1500 use Moo;
  1         3  
  1         9  
10 1     1   2940 use strict;
  1         3  
  1         27  
11 1     1   6 use warnings;
  1         2  
  1         37  
12 1     1   6 use version;
  1         2  
  1         12  
13 1     1   81 use Carp;
  1         2  
  1         89  
14 1     1   7 use English qw/ -no_match_vars /;
  1         3  
  1         11  
15 1     1   453 use IO::Prompt qw/prompt/;
  1         3  
  1         13  
16 1     1   91 use JSON qw/decode_json/;
  1         3  
  1         10  
17 1     1   119 use WWW::Mechanize;
  1         3  
  1         78  
18 1     1   7 use Path::Tiny;
  1         2  
  1         1391  
19              
20             our $VERSION = version->new('0.7.6');
21              
22             extends 'Group::Git';
23              
24             has '+recurse' => (
25             default => 1,
26             );
27             has 'mech' => (
28             is => 'rw',
29             lazy => 1,
30             builder => '_mech',
31             );
32              
33             sub _mech {
34 0     0     my ($self) = @_;
35 0           my $mech;
36              
37 0 0         if ( ! -d $self->conf->{cache_dir} ) {
38 0           mkdir $self->conf->{cache_dir};
39             }
40              
41 0 0 0       if ($self->conf->{cache_dir} && eval { require WWW::Mechanize::Cached; require CHI }) {
  0            
  0            
42             $mech = WWW::Mechanize::Cached->new(
43             cache => CHI->new(
44             driver => 'File',
45             root_dir => $self->conf->{cache_dir},
46 0           expires_in => '60 min',
47             ),
48             );
49             }
50             else {
51 0           $mech = WWW::Mechanize->new;
52             }
53              
54 0           return $mech;
55             }
56              
57             sub _httpenc {
58 0     0     my ($str) = @_;
59 0           $str =~ s/(\W)/sprintf "%%%x", ord $1/egxms;
  0            
60 0           return $str;
61             }
62              
63             sub _repos {
64 0     0     my ($self) = @_;
65 0           my %repos = %{ $self->SUPER::_repos() };
  0            
66              
67 0           my ($conf) = $self->conf;
68             #EG curl --user buserbb:2934dfad https://stash.example.com/rest/api/1.0/repos
69              
70 0           my @argv = @ARGV;
71 0           @ARGV = ();
72 0           my $mech = $self->mech;
73 0 0         my $user = _httpenc( $conf->{username} ? $conf->{username} : prompt( -prompt => 'stash username : ' ) );
74 0 0         my $pass = _httpenc( $conf->{password} ? $conf->{password} : prompt( -prompt => 'stash password : ', -echo => '*' ) );
75 0           my $url = "https://$user:$pass\@$conf->{stash_host}/rest/api/1.0/repos?limit=100&start=";
76 0           my $start = 0;
77 0           my $more = 1;
78 0           @ARGV = @argv;
79 0 0         my %exclude = map {$_ => 1} @{ $self->{conf}{'exclude-tags'} || [] };
  0            
  0            
80              
81 0           while ($more) {
82 0           $mech->get( $url . $start );
83 0 0         if ( $mech->status != 200 ) {
84 0           warn 'Error (', $mech->status, ") accessing $url$start\n";
85 0           last;
86             }
87 0           my $response = eval { decode_json $mech->content };
  0            
88 0 0         if ( !$response ) {
    0          
89 0   0       die $@ || "Error occured processing stash server response\n";
90             }
91             elsif ( $response->{errors} ) {
92 0           die join '', map {"$_->{message}\n"} @{ $response->{errors} };
  0            
  0            
93             }
94              
95             REPO:
96 0           for my $repo (@{ $response->{values} }) {
  0            
97 0           my $project = $repo->{project}{name};
98 0           my $url = $repo->{links}{self}[0]{href};
99 0           my %clone = map {($_->{name} => $_->{href})} @{ $repo->{links}{clone} };
  0            
  0            
100 0 0 0       my $git = $conf->{clone_type} && $conf->{clone_type} eq 'http' ? $clone{http} : $clone{ssh};
101 0 0         my ($dir) = $self->recurse ? $git =~ m{([^/]+/[^/]+?)(?:[.]git)?$} : $git =~ m{/([^/]+?)(?:[.]git)?$};
102 0 0         my $name = $self->recurse ? path("$project/$repo->{name}") : path($repo->{name});
103 0           $dir =~ s/^~//xms;
104 0 0         next if $exclude{$repo->{project}{owner} ? 'personal' : 'project'};
    0          
105 0 0 0       next if $self->{conf}{skip} && $project =~ /$self->{conf}{skip}/;
106              
107             $repos{$dir} = Group::Git::Repo->new(
108             name => path($dir),
109             url => $url,
110             git => $conf->{clone_type} && $conf->{clone_type} eq 'http' ? $clone{http} : $clone{ssh},
111             tags => {
112             $project => 1,
113 0 0 0       ($repo->{project}{owner} ? 'personal' : 'project') => 1,
    0          
114             },
115             );
116 0           push @{ $conf->{tags}{$project} }, "$dir";
  0            
117 0           push @{ $conf->{tags}{$repo->{project}{type}} }, "$dir";
  0            
118              
119 0 0         if ( $repo->{project}{owner} ) {
120 0           push @{ $conf->{tags}{personal} }, "$dir";
  0            
121             }
122             else {
123 0           push @{ $conf->{tags}{project} }, "$dir";
  0            
124             }
125             }
126 0 0         last if $response->{isLastPage};
127 0           $start = $response->{nextPageStart};
128             }
129              
130 0           return \%repos;
131             }
132              
133             1;
134              
135             __END__
136              
137             =head1 NAME
138              
139             Group::Git::Stash - Adds reading all repositories you have access to on your local Stash server
140              
141             =head1 VERSION
142              
143             This documentation refers to Group::Git::Stash version 0.7.6.
144              
145             =head1 SYNOPSIS
146              
147             use Group::Git::Stash;
148              
149             # pull (or clone missing) all repositories that joeblogs has created/forked
150             my $ggs = Group::Git::Stash->new(
151             conf => {
152             username => 'joeblogs@example.com',
153             password => 'myverysecurepassword',
154             },
155             # resursive is turned on by default for stash to allow for stash projects
156             recurse => 1,
157             );
158              
159             # list all repositories
160             my $repositories = $ggs->repo();
161              
162             # do something to each repository
163             for my $repo (keys %{$repositories}) {
164             # eg do a pull
165             $ggs->pull($repo);
166             }
167              
168             =head1 DESCRIPTION
169              
170             Reads all repositories that the configured user has access to. Note: if no
171             user is set up (or no password is supplied) then you will be prompted to
172             enter the username and/or password.
173              
174             =head2 Auto Tagging
175              
176             Stash repositories are automatically tagged with the project they belong to
177             and the type of repository according to stash (e.g. NORMAL or PERSONAL).
178              
179             =head1 SUBROUTINES/METHODS
180              
181             =over 4
182              
183             =item mech
184              
185             Property for storing the L<WWW::Mechanize> object for talking to stash
186              
187             =back
188              
189             =head1 DIAGNOSTICS
190              
191             =head1 CONFIGURATION AND ENVIRONMENT
192              
193             When using with the C<group-git> command the group-git.yml can be used
194             to configure this plugin:
195              
196             C<group-git.yml>
197              
198             ---
199             type: Stash
200             username: stash.user
201             password: supperSecret
202             stash_host: stash.example.com
203              
204             =head1 DEPENDENCIES
205              
206             =head1 INCOMPATIBILITIES
207              
208             =head1 BUGS AND LIMITATIONS
209              
210             There are no known bugs in this module.
211              
212             Please report problems to Ivan Wills (ivan.wills@gmail.com).
213              
214             Patches are welcome.
215              
216             =head1 AUTHOR
217              
218             Ivan Wills - (ivan.wills@gmail.com)
219              
220             =head1 LICENSE AND COPYRIGHT
221              
222             Copyright (c) 2013 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW Australia 2077).
223             All rights reserved.
224              
225             This module is free software; you can redistribute it and/or modify it under
226             the same terms as Perl itself. See L<perlartistic>. This program is
227             distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
228             without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
229             PARTICULAR PURPOSE.
230              
231             =cut