File Coverage

blib/lib/GitHub/Crud.pm
Criterion Covered Total %
statement 55 662 8.3
branch 3 298 1.0
condition 0 95 0.0
subroutine 17 77 22.0
pod 37 52 71.1
total 112 1184 9.4


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -I/home/phil/perl/cpan/DataTableText/lib
2             #-------------------------------------------------------------------------------
3             # Create, Read, Update, Delete files, commits, issues, and web hooks on GitHub.
4             # Per: https://developer.github.com/v3/
5             # Philip R Brenan at gmail dot com, Appa Apps Ltd, 2017-2020
6             #-------------------------------------------------------------------------------
7             #podDocumentation
8             package GitHub::Crud;
9 1     1   1029 use v5.16;
  1         11  
10             our $VERSION = 202102121;
11 1     1   7 use warnings FATAL => qw(all);
  1         2  
  1         31  
12 1     1   5 use strict;
  1         2  
  1         35  
13 1     1   7 use Carp qw(confess);
  1         2  
  1         102  
14 1     1   590 use Data::Dump qw(dump);
  1         8222  
  1         118  
15 1     1   4143 use Data::Table::Text qw(:all !fileList);
  1         150409  
  1         1739  
16 1     1   668 use Digest::SHA1 qw(sha1_hex);
  1         773  
  1         55  
17 1     1   516 use Date::Manip;
  1         148657  
  1         141  
18 1     1   11 use Scalar::Util qw(blessed reftype looks_like_number);
  1         2  
  1         63  
19 1     1   7 use Time::HiRes qw(time);
  1         2  
  1         9  
20 1     1   126 use Encode qw(encode decode);
  1         2  
  1         45  
21 1     1   5 use utf8; # To allow utf8 constants for testing
  1         2  
  1         4  
22              
23 0     0 0 0 sub url { "https://api.github.com/repos" } # Github repository api url
24 0     0 0 0 sub api { "https://api.github.com/" } # Github api url
25 0     0 0 0 sub accessFolder { q(/etc/GitHubCrudPersonalAccessToken) }; # Personal access tokens are stored in a file in this folder with the name of the userid of the L repository
26              
27             my %shas; # L digests already seen - used to optimize write and delete
28              
29             sub GitHub::Crud::Response::new($$) #P Execute a request against L and decode the response
30 0     0   0 {my ($gitHub, $request) = @_; # Github, request string
31              
32 0         0 my $R = bless {command=>$request}, "GitHub::Crud::Response"; # Construct the response
33              
34 0         0 my $r = xxx $request, qr(HTTP);
35              
36 0         0 $r =~ s/\r//gs; # Internet line ends
37 0         0 my ($http, @r) = split /\n/, $r;
38 0   0     0 while(@r > 2 and $http =~ "HTTP" and $http =~ /100/) # Continue messages
      0        
39 0         0 {shift @r; $http = shift @r;
  0         0  
40             }
41              
42 0 0 0     0 if ($http and $http =~ "HTTP" and $http =~ /200|201|404|409|422/)
      0        
43 0         0 {my $ps = 0; # Parse the response
44 0         0 my @data;
45             my %can;
46              
47 0         0 for(@r)
48 0 0       0 {if ($ps == 0)
49 0 0       0 {if (length == 0)
50 0         0 {$ps = 1;
51             }
52             else
53 0         0 {my ($name, $content) = split /\s*:\s*/, $_, 2; # Parse each header
54 0         0 $name =~ s/-/_/gs; # Translate - in names to _
55 0 0       0 if ($R->can($name))
56 0         0 {$R->$name = $content;
57             }
58 0         0 else {$can{$name}++} # Update list of new methods required
59             }
60             }
61             else
62 0         0 {push @data, $_;
63             }
64             }
65              
66 0 0       0 if (keys %can) # List of new methods required
67 0         0 {lll "Add the following fields to package GitHub::Crud::Response";
68 0         0 say STDERR " $_=> undef," for(sort keys %can);
69             }
70              
71 0 0       0 if (@data) # Save any data
72 0         0 {my $j = join ' ', @data;
73 0         0 my $p = $R->data = bless decodeJson($j), "GitHub::Crud::Response::Data";
74 0 0 0     0 if (ref($p) =~ m/hash/is and my $c = $p->content)
75 0         0 {$R->content = decodeBase64($c); # Decode the data
76             }
77             }
78              
79 0   0     0 ($R->status) = split / /, $R->Status || $R->status || 200; # Save response status - github returns status == 0 when running as an action so we make it 200
80              
81 0         0 return $gitHub->response = $R; # Return successful response
82             }
83             else
84 0         0 {confess "Unexpected response from GitHub:\n$r\n$request\n"; # Confess to failure
85             }
86             }
87              
88             genHash(q(GitHub::Crud::Response), # Attributes describing a response from L.
89             Accept_Ranges => undef,
90             access_control_allow_origin => undef,
91             Access_Control_Allow_Origin => undef,
92             access_control_expose_headers => undef,
93             Access_Control_Expose_Headers => undef,
94             cache_control => undef,
95             Cache_Control => undef,
96             Connection => undef,
97             content_length => undef,
98             Content_Length => undef,
99             content_security_policy => undef,
100             Content_Security_Policy => undef,
101             content_type => undef,
102             Content_Type => undef,
103             content => undef, # The actual content of the file from L.
104             data => undef, # The data received from L, normally in L format.
105             date => undef,
106             Date => undef,
107             etag => undef,
108             ETag => undef,
109             Expires => undef,
110             last_modified => undef,
111             Last_Modified => undef,
112             Link => undef,
113             Location => undef,
114             referrer_policy => undef,
115             Referrer_Policy => undef,
116             server => undef,
117             Server => undef,
118             Source_Age => undef,
119             Status => undef,
120             status => undef, # Our version of Status.
121             strict_transport_security => undef,
122             Strict_Transport_Security => undef,
123             vary => undef,
124             Vary => undef,
125             Via => undef,
126             x_accepted_oauth_scopes => undef,
127             X_Accepted_OAuth_Scopes => undef,
128             X_Cache_Hits => undef,
129             X_Cache => undef,
130             x_content_type_options => undef,
131             X_Content_Type_Options => undef,
132             X_Content_Type => undef,
133             X_Fastly_Request_ID => undef,
134             x_frame_options => undef,
135             X_Frame_Options => undef,
136             X_Geo_Block_List => undef,
137             x_github_media_type => undef,
138             X_GitHub_Media_Type => undef,
139             x_github_request_id => undef,
140             X_GitHub_Request_Id => undef,
141             x_oauth_scopes => undef,
142             X_OAuth_Scopes => undef,
143             x_ratelimit_limit => undef,
144             X_RateLimit_Limit => undef,
145             x_ratelimit_remaining => undef,
146             X_RateLimit_Remaining => undef,
147             x_ratelimit_reset => undef,
148             X_RateLimit_Reset => undef,
149             x_ratelimit_used => undef,
150             X_RateLimit_Used => undef,
151             X_Runtime_rack => undef,
152             X_Served_By => undef,
153             X_Timer => undef,
154             x_xss_protection => undef,
155             X_XSS_Protection => undef,
156             );
157              
158             genHash(q(GitHub::Crud::Response::Data), # Response from a request made to L.
159             command => undef,
160             content => undef,
161             documentation_url => undef,
162             download_url => undef,
163             encoding => undef,
164             git => undef,
165             git_url => undef,
166             html => undef,
167             html_url => undef,
168             _links => undef,
169             message => undef,
170             name => undef,
171             path => undef,
172             self => undef,
173             sha => undef,
174             size => undef,
175             type => undef,
176             url => undef,
177             );
178              
179             sub getSha($) #P Compute L for data after encoding any unicode characters as utf8.
180 0     0 0 0 {my ($data) = @_; # String possibly containing non ascii code points
181              
182 0         0 my $length = length($data);
183 0         0 my $blob = 'blob' . " $length\0" . $data;
184 0         0 utf8::encode($blob);
185 0         0 my $r = eval{sha1_hex($blob)};
  0         0  
186 0 0       0 confess $@ if $@;
187 0         0 $r
188             }
189              
190             if (0) # Test L
191             {my $sha = getSha("

Hello World

\n");
192             my $Sha = "f3e333e80d224c631f2ff51b9b9f7189ad349c15";
193             unless($sha eq $Sha)
194             {confess "Wrong SHA: $sha".
195             "Should be: $Sha";
196             }
197             confess "getSha success";
198             }
199              
200             sub shaKey($;$) #P Add a L key to a L
201 0     0 0 0 {my ($gitHub, $fileData) = @_; # Github, optional fileData to specify the file to use if it is not gitFile
202 0 0       0 filePath($gitHub->repository,
203             $fileData ? ($fileData->path, $fileData->name) : $gitHub->gitFile)
204             }
205              
206             sub saveSha($$) #P Save the L of a file
207 0     0 0 0 {my ($gitHub, $fileData) = @_; # Github, file details returned by list or exists
208 0         0 $shas{$gitHub->shaKey($fileData)} = $fileData->sha;
209             }
210              
211             sub copySha($) #P Save the L of a file just read to a file just about to be written
212 0     0 0 0 {my ($gitHub) = @_; # Github
213 0         0 $shas{$gitHub->shaKey} = $gitHub->response->data->sha;
214             }
215              
216             sub getExistingSha($) #P Get the L of a file that already exists
217 0     0 0 0 {my ($gitHub) = @_; # Github
218 0         0 my $s = $shas{$gitHub->shaKey}; # Get the L from the cache
219 0 0       0 return $s if defined $s; # A special L of 0 means the file was deleted
220 0         0 my $r = $gitHub->exists; # Get the L of the file via exists if the file exists
221 0 0       0 return $r->sha if $r; # L of existing file
222             undef # Undef if no such file
223 0         0 }
224              
225             sub deleteSha($) #P Delete a L that is no longer valid
226 0     0 0 0 {my ($gitHub) = @_; # Github
227 0         0 $shas{$gitHub->shaKey} = undef # Mark the L as deleted
228             }
229              
230             sub qm($) #P Quotemeta extended to include undef
231 0     0 0 0 {my ($s) = @_; # String to quote
232 0 0       0 return '' unless $s;
233 0         0 $s =~ s((\'|\"|\\)) (\\$1)gs;
234 0         0 $s =~ s(\s) (%20)gsr; # Url encode blanks
235             }
236              
237             sub patKey($) #P Create an authorization header by locating an appropriate personal access token
238 0     0 0 0 {my ($gitHub) = @_; # GitHub
239              
240 0 0       0 $gitHub->loadPersonalAccessToken unless $gitHub->personalAccessToken; # Load a personal access token if none has been supplied
241              
242 0 0       0 if (my $pat = $gitHub->personalAccessToken) # User supplied personal access token explicitly
243 0         0 {return "-H \"Authorization: token $pat\""
244             }
245              
246 0         0 confess "Personal access token required with scope \"public_repo\"". # We must have a personal access token to do anything useful!
247             " as generated on page:\nhttps://github.com/settings/tokens";
248             }
249              
250             sub refOrBranch($$) #P Add a ref or branch keyword
251 0     0 0 0 {my ($gitHub, $ref) = @_; # Github, whether to use ref rather than branch
252 0         0 my $b = $gitHub->branch;
253 0 0 0     0 return "?ref=$b" if $ref and $b;
254 0 0 0     0 return "?branch=$b" if !$ref and $b;
255 0         0 ''
256             }
257              
258             sub gitHub(%) #P Create a test L object
259 0     0 0 0 {my (%options) = @_; # Options
260 0         0 GitHub::Crud::new
261             (userid => q(philiprbrenan),
262             repository => q(aaa),
263             confessOnFailure => 1,
264             @_);
265             }
266              
267             #D1 Constructor # Create a L object with the specified attributes describing the interface with L.
268              
269             sub new(@) # Create a new L object with attributes as described at: L.
270 0     0 1 0 {my (%attributes) = @_; # Attribute values
271              
272 0         0 my $curl = qx(curl -V); # Check Curl
273 0 0       0 if ($curl =~ /command not found/)
274 0         0 {confess "Command curl not found"
275             }
276              
277 0         0 my $g = genHash(__PACKAGE__, # Attributes describing the interface with L.
278             body => undef, #I The body of an issue.
279             branch => undef, #I Branch name (you should create this branch first) or omit it for the default branch which is usually 'master'.
280             confessOnFailure => undef, #I Confess to any failures
281             failed => undef, # Defined if the last request to L failed else B.
282             fileList => undef, # Reference to an array of files produced by L.
283             gitFile => undef, #I File name on L - this name can contain '/'. This is the file to be read from, written to, copied from, checked for existence or deleted.
284             gitFolder => undef, #I Folder name on L - this name can contain '/'.
285             message => undef, #I Optional commit message
286             nonRecursive => undef, #I Fetch only one level of files with L.
287             personalAccessToken => undef, #I A personal access token with scope "public_repo" as generated on page: https://github.com/settings/tokens.
288             personalAccessTokenFolder => accessFolder, #I The folder into which to save personal access tokens. Set to q(/etc/GitHubCrudPersonalAccessToken) by default.
289             private => undef, #I Whether the repository being created should be private or not.
290             readData => undef, # Data produced by L.
291             repository => undef, #I The name of the repository to be worked on minus the userid - you should create this repository first manually.
292             response => undef, # A reference to L's response to the latest request.
293             secret => undef, #I The secret for a web hook - this is created by the creator of the web hook and remembered by L,
294             title => undef, #I The title of an issue.
295             webHookUrl => undef, #I The url for a web hook.
296             userid => undef, #I Userid on L of the repository to be worked on.
297             );
298              
299 0         0 $g->$_ = $attributes{$_} for sort keys %attributes;
300              
301 0         0 $g
302             }
303              
304             #D1 Files # File actions on the contents of L repositories.
305              
306             sub list($) # List all the files contained in a L repository or all the files below a specified folder in the repository.\mRequired attributes: L, L.\mOptional attributes: L, L, L, L.\mUse the L parameter to specify the folder to start the list from, by default, the listing will start at the root folder of your repository.\mUse the L option if you require only the files in the start folder as otherwise all the folders in the start folder will be listed as well which might take some time.\mIf the list operation is successful, L is set to false and L is set to refer to an array of the file names found.\mIf the list operation fails then L is set to true and L is set to refer to an empty array.\mReturns the list of file names found or empty list if no files were found.
307 0     0 1 0 {my ($gitHub) = @_; # GitHub
308             my $r = sub # Get contents
309 0 0   0   0 {my $user = qm $gitHub->userid; $user or confess "userid required";
  0         0  
310 0 0       0 my $repo = qm $gitHub->repository; $repo or confess "repository required";
  0         0  
311 0   0     0 my $path = qm $gitHub->gitFolder || '';
312 0         0 my $bran = qm $gitHub->refOrBranch(1);
313 0         0 my $pat = $gitHub->patKey(0);
314 0         0 my $url = url;
315 0         0 my $s = filePath
316             ("curl -si $pat $url", $user, $repo, qq(contents), $path.$bran);
317 0         0 GitHub::Crud::Response::new($gitHub, $s);
318 0         0 }->();
319              
320 0         0 my $failed = $gitHub->failed = $r->status != 200; # Check response code
321 0 0 0     0 $failed and $gitHub->confessOnFailure and confess dump($gitHub); # Confess to any failure if so requested
322              
323 0         0 $gitHub->fileList = [];
324 0 0 0     0 if (!$failed and reftype($r->data) =~ m(array)i) # Array of file details
325 0         0 {for(@{$r->data}) # Objectify and save L digests from file descriptions retrieved by this call
  0         0  
326 0         0 {bless $_, "GitHub::Crud::Response::Data";
327 0         0 saveSha($gitHub, $_);
328             }
329              
330 0   0     0 my $path = $gitHub->gitFolder || '';
331 0         0 my @d = map{filePath $path, $_->name} grep {$_->type eq "dir"} @{$r->data};# Folders
  0         0  
  0         0  
  0         0  
332 0         0 my @f = map{filePath $path, $_->name} grep {$_->type eq "file"} @{$r->data};# Files
  0         0  
  0         0  
  0         0  
333              
334 0 0       0 unless($gitHub->nonRecursive) # Get the contents of sub folders unless otherwise specified
335 0         0 {for my $d(@d)
336 0         0 {my $p = $gitHub->gitFolder = $d;
337 0         0 push @f, $gitHub->list;
338             }
339             }
340 0         0 $gitHub->gitFolder = $path; # Restore path supplied by the user
341 0         0 $gitHub->fileList = [@f]; # List of files not directories
342             }
343 0         0 @{$gitHub->fileList}
  0         0  
344             }
345              
346             sub specialFileData($) # Do not encode or decode data with a known file signature
347 0     0 1 0 {my ($d) = @_; # String to check
348 0         0 my $h = '';
349 0 0 0     0 if ($d and length($d) > 8) # Read file magic number
350 0         0 {for my $e(0..7)
351 0         0 {$h .= sprintf("%x", ord(substr($d, $e, 1)));
352             }
353 0 0       0 return 1 if $h =~ m(\A504b)i; # PK Zip
354 0 0       0 return 1 if $h =~ m(\Ad0cf11e0)i; # OLE files
355 0 0       0 return 1 if $h =~ m(\Affd8ff)i; # Jpg
356 0 0       0 return 1 if $h =~ m(\A89504e470d0a1a0a)i; # Png
357 0 0       0 return 1 if $h =~ m(\A4D546864)i; # Midi
358 0 0       0 return 1 if $h =~ m(\A49443340)i; # Mp3
359             }
360             0 # Not a special file
361 0         0 }
362              
363             sub read($;$) # Read data from a file on L.\mRequired attributes: L, L.\mOptional attributes: L = the file to read, L, L.\mIf the read operation is successful, L is set to false and L is set to the data read from the file.\mIf the read operation fails then L is set to true and L is set to B.\mReturns the data read or B if no file was found.
364 0     0 1 0 {my ($gitHub, $File) = @_; # GitHub, file o read if not specified in gitFile
365              
366 0 0       0 my $user = qm $gitHub->userid; $user or confess "userid required";
  0         0  
367 0 0       0 my $repo = qm $gitHub->repository; $repo or confess "repository required";
  0         0  
368 0 0 0     0 my $file = qm($File//$gitHub->gitFile); $file or confess "gitFile required";
  0         0  
369 0         0 my $bran = qm $gitHub->refOrBranch(1);
370 0         0 my $pat = $gitHub->patKey(0);
371              
372 0         0 my $url = url;
373 0         0 my $s = filePath(qq(curl -si $pat $url),
374             $user, $repo, qq(contents), $file.$bran);
375 0         0 my $r = GitHub::Crud::Response::new($gitHub, $s); # Get response from GitHub
376 0         0 my $failed = $gitHub->failed = $r->status != 200; # Check response code
377 0 0 0     0 $failed and $gitHub->confessOnFailure and confess dump($gitHub); # Confess to any failure if so requested
378              
379 0 0       0 if ($failed) # Decode data unless read failed
380 0         0 {$gitHub->readData = undef;
381             }
382             else # Decode data
383 0         0 {my $d = decodeBase64($r->data->content);
384 0 0       0 $gitHub->readData = specialFileData($d) ? $d : decode "UTF8", $d; # Convert to utf unless a known file format
385             }
386              
387 0         0 $gitHub->readData
388             }
389              
390             sub write($$;$) # Write utf8 data into a L file.\mRequired attributes: L, L, L. Either specify the target file on: using the L attribute or supply it as the third parameter. Returns B on success else L.
391 0     0 1 0 {my ($gitHub, $data, $File) = @_; # GitHub object, data to be written, optionally the name of the file on github
392              
393 0 0       0 unless($data) # No data supplied so delete the file
394 0 0       0 {if ($File)
395 0         0 {my $file = $gitHub->file;
396 0         0 $gitHub->file = $File;
397 0         0 $gitHub->delete;
398 0         0 $gitHub->file = $file;
399             }
400             else
401 0         0 {$gitHub->delete;
402             }
403 0         0 return 'empty'; # Success
404             }
405              
406 0         0 my $pat = $gitHub->patKey(1);
407 0 0       0 my $user = qm $gitHub->userid; $user or confess "userid required";
  0         0  
408 0 0       0 my $repo = qm $gitHub->repository; $repo or confess "repository required";
  0         0  
409 0 0 0     0 my $file = qm($File//$gitHub->gitFile); $file or confess "gitFile required";
  0         0  
410 0   0     0 my $bran = qm $gitHub->refOrBranch(0) || '?';
411 0         0 my $mess = qm $gitHub->message;
412              
413 0 0       0 if (!specialFileData($data)) # Send the data as utf8 unless it is a special file
414 1     1   3126 {use Encode 'encode';
  1         2  
  1         6104  
415 0         0 $data = encode('UTF-8', $data);
416             }
417              
418 0         0 my $url = url;
419 0         0 my $save = $gitHub->gitFile; # Save any existing file name as we might need to update it to get the sha if the target file was supplied as a parameter to this sub
420 0 0       0 $gitHub->gitFile = $File if $File; # Set target file name so we can get its sha
421 0   0     0 my $s = $gitHub->getExistingSha || getSha($data); # Get the L of the file if the file exists
422 0         0 $gitHub->gitFile = $save; # Restore file name
423 0 0       0 my $sha = $s ? ', "sha": "'. $s .'"' : ''; # L of existing file or blank string if no existing file
424              
425             # if ($s and my $S = getSha($data)) # L of new data
426             # {if ($s eq $S) # Duplicate if the Ls match
427             # {$gitHub->failed = undef;
428             # return 1;
429             # }
430             # }
431              
432 0         0 my $denc = encodeBase64($data) =~ s/\n//gsr;
433              
434             my $branch = sub # It seems we must put the branch in the json file though the documentation seems to imply it can go in the url or the json
435 0     0   0 {my $b = $gitHub->branch;
436 0 0       0 return qq(, "branch" : "$b") if $b;
437 0         0 q()
438 0         0 }->();
439              
440 0         0 my $j = qq({"message": "$mess", "content": "$denc" $sha $branch});
441 0         0 my $t = writeFile(undef, $j); # Write encoded content to temporary file
442 0         0 my $d = qq(-d @).$t;
443 0         0 my $u = filePath($url, $user, $repo, qw(contents), $file.$bran);
444 0         0 my $c = qq(curl -si -X PUT $pat $u $d); # Curl command
445 0         0 my $r = GitHub::Crud::Response::new($gitHub, $c); # Execute command to create response
446 0         0 unlink $t; # Cleanup
447              
448 0         0 my $status = $r->status; # Check response code
449 0 0       0 my $success = $status == 200 ? 'updated' : $status == 201 ? 'created' : undef;# Updated, created
    0          
450 0 0       0 $gitHub->failed = $success ? undef : 1;
451 0 0 0     0 !$success and $gitHub->confessOnFailure and confess dump($gitHub); # Confess to any failure if so requested
452              
453 0         0 $success # Return true on success
454             }
455              
456             sub readBlob($$) # Read a L from L.\mRequired attributes: L, L, L. Returns the content of the L identified by the specified L.
457 0     0 1 0 {my ($gitHub, $sha) = @_; # GitHub object, data to be written
458 0 0       0 defined($sha) or confess "sha required";
459              
460 0         0 my $pat = $gitHub->patKey(1);
461 0 0       0 my $user = qm $gitHub->userid; $user or confess "userid required";
  0         0  
462 0 0       0 my $repo = qm $gitHub->repository; $repo or confess "repository required";
  0         0  
463 0         0 my $url = url;
464              
465 0         0 my $u = filePath($url, $user, $repo, qw(git blobs), $sha); # Url
466 0         0 my $c = qq(curl -si $pat $u); # Curl command
467 0         0 my $r = GitHub::Crud::Response::new($gitHub, $c); # Execute command to create response
468              
469 0         0 my $status = $r->status; # Check response code
470 0         0 my $success = $status == 200;
471 0 0       0 $gitHub->failed = $success ? undef : 1;
472 0 0 0     0 !$success and $gitHub->confessOnFailure and confess dump($gitHub); # Confess to any failure if so requested
473              
474 0 0       0 $success ? decodeBase64($gitHub->response->data->content) : undef # Return content on success else undef
475             }
476              
477             sub writeBlob($$) # Write data into a L as a L that can be referenced by future commits.\mRequired attributes: L, L, L. Returns the L of the created L or L in a failure occurred.
478 0     0 1 0 {my ($gitHub, $data) = @_; # GitHub object, data to be written
479 0 0       0 defined($data) or confess "binary data required";
480              
481 0         0 my $pat = $gitHub->patKey(1);
482 0 0       0 my $user = qm $gitHub->userid; $user or confess "userid required";
  0         0  
483 0 0       0 my $repo = qm $gitHub->repository; $repo or confess "repository required";
  0         0  
484 0         0 my $url = url;
485              
486 0         0 my $denc = encodeBase64($data) =~ s/\n//gsr;
487 0         0 my $t = writeTempFile(qq({"content": "$denc", "encoding" : "base64"})); # Write encoded content to temporary file
488 0         0 my $d = qq(-d @).$t;
489 0         0 my $u = filePath($url, $user, $repo, qw(git blobs));
490 0         0 my $c = qq(curl -si -X POST $pat $u $d); # Curl command
491 0         0 my $r = GitHub::Crud::Response::new($gitHub, $c); # Execute command to create response
492 0         0 unlink $t; # Cleanup
493              
494 0         0 my $status = $r->status; # Check response code
495 0 0       0 my $success = $status == 200 ? 'updated' : $status == 201 ? 'created' : undef;# Updated, created
    0          
496 0 0       0 $gitHub->failed = $success ? undef : 1;
497 0 0 0     0 !$success and $gitHub->confessOnFailure and confess dump($gitHub); # Confess to any failure if so requested
498              
499 0 0       0 $success ? $gitHub->response->data->sha : undef # Return sha of blob on success
500             }
501              
502             sub copy($$) # Copy a source file from one location to another target location in your L repository, overwriting the target file if it already exists.\mRequired attributes: L, L, L, L = the file to be copied.\mOptional attributes: L.\mIf the write operation is successful, L is set to false otherwise it is set to true.\mReturns B if the write updated the file, B if the write created the file else B if the write failed.
503 0     0 1 0 {my ($gitHub, $target) = @_; # GitHub object, the name of the file to be created
504 0 0       0 defined($target) or confess "Specify the name of the file to be copied to";
505 0         0 my $r = $gitHub->read; # Read the content of the source file
506 0 0       0 if (defined $r)
507 0         0 {my $file = $gitHub->gitFile; # Save current source file
508 0         0 my $sha = $gitHub->response->data->sha; # L of last file read
509 0         0 $gitHub->gitFile = $target; # Set target file as current file
510 0         0 my $R = $gitHub->write($r); # Write content to target file
511 0         0 $gitHub->copySha; # Copy the L from the file just read
512 0         0 $gitHub->gitFile = $file; # Restore source file
513 0         0 return $R; # Return response from write
514             }
515             undef # Failed
516 0         0 }
517              
518             sub exists($) # Test whether a file exists on L or not and returns an object including the B and B fields if it does else L.\mRequired attributes: L, L, L file to test.\mOptional attributes: L, L.
519 0     0 1 0 {my ($gitHub) = @_; # GitHub object
520 0         0 my @file = split /\//, $gitHub->gitFile;
521 0 0       0 confess "gitFile required to name the file to be checked" unless @file;
522 0         0 pop @file;
523 0         0 my $folder = $gitHub->gitFolder;
524 0         0 my $nonRecursive = $gitHub->nonRecursive;
525 0         0 $gitHub->gitFolder = filePath(@file);
526 0         0 $gitHub->nonRecursive = 1;
527 0         0 my $r = $gitHub->list; # Get a file listing
528 0         0 $gitHub->gitFolder = $folder;
529 0         0 $gitHub->nonRecursive = $nonRecursive;
530              
531 0 0 0     0 if (!$gitHub->failed and reftype($gitHub->response->data) =~ m(array)i) # Look for requested file in file listing
532 0         0 {for(@{$gitHub->response->data})
  0         0  
533 0 0       0 {return $_ if $_->path eq $gitHub->gitFile;
534             }
535             }
536             undef
537 0         0 }
538              
539             sub rename($$) # Rename a source file on L if the target file name is not already in use.\mRequired attributes: L, L, L, L = the file to be renamed.\mOptional attributes: L.\mReturns the new name of the file B if the rename was successful else B if the rename failed.
540 0     0 1 0 {my ($gitHub, $target) = @_; # GitHub object, the new name of the file
541 0         0 my $file = $gitHub->gitFile;
542 0         0 $gitHub->gitFile = $target;
543 0 0       0 return undef if $gitHub->exists;
544 0         0 $gitHub->gitFile = $file;
545 0         0 $gitHub->copy($target);
546 0         0 $gitHub->gitFile = $target;
547 0 0       0 if ($gitHub->exists)
548 0         0 {$gitHub->gitFile = $file;
549 0 0       0 return $target if $gitHub->delete;
550 0         0 confess "Failed to delete source file $file";
551             }
552             undef
553 0         0 }
554              
555             sub delete($) # Delete a file from L.\mRequired attributes: L, L, L, L = the file to be deleted.\mOptional attributes: L.\mIf the delete operation is successful, L is set to false otherwise it is set to true.\mReturns true if the delete was successful else false.
556 0     0 1 0 {my ($gitHub) = @_; # GitHub object
557              
558 0         0 my $pat = $gitHub->patKey(1);
559 0 0       0 my $user = qm $gitHub->userid; $user or confess "userid required";
  0         0  
560 0 0       0 my $repo = qm $gitHub->repository; $repo or confess "repository required";
  0         0  
561 0 0       0 my $file = qm $gitHub->gitFile; $file or confess "file to delete required";
  0         0  
562 0         0 my $bran = qm $gitHub->refOrBranch(0);
563 0         0 my $url = url;
564              
565 0         0 my $s = $gitHub->getExistingSha; # L of existing file or undef
566 0 0       0 return 2 unless $s; # File already deleted
567 0         0 my $sha = ' -d \'{"message": "", "sha": "'. $s .'"}\'';
568 0         0 my $u = filePath($url, $user, $repo, qw(contents), $file.$bran.$sha);
569 0         0 my $d = "curl -si -X DELETE $pat $u";
570 0         0 my $r = GitHub::Crud::Response::new($gitHub, $d);
571 0         0 my $success = $r->status == 200; # Check response code
572 0 0       0 $gitHub->deleteSha if $success; # The L is no longer valid
573 0 0       0 $gitHub->failed = $success ? undef : 1;
574 0 0 0     0 !$success and $gitHub->confessOnFailure and confess dump($gitHub); # Confess to any failure if so requested
575 0 0       0 $success ? 1 : undef # Return true on success
576             }
577              
578             #D1 Repositories # Perform actions on L repositories.
579              
580             sub getRepository($) # Get the overall details of a repository
581 0     0 1 0 {my ($gitHub) = @_; # GitHub object
582              
583 0         0 my $pat = $gitHub->patKey(1);
584 0 0       0 my $user = qm $gitHub->userid; $user or confess "userid required";
  0         0  
585 0 0       0 my $repo = qm $gitHub->repository; $repo or confess "repository required";
  0         0  
586 0         0 my $url = url;
587              
588 0         0 my $c = qq(curl -si $pat $url/$user/$repo);
589 0         0 my $r = GitHub::Crud::Response::new($gitHub, $c);
590 0         0 my $success = $r->status == 200; # Check response code
591 0 0 0     0 !$success and $gitHub->confessOnFailure and confess dump([$gitHub, $c]); # Confess to any failure if so requested
592              
593 0         0 $r
594             }
595              
596             sub listCommits($) # List all the commits in a L repository.\mRequired attributes: L, L.
597 0     0 1 0 {my ($gitHub) = @_; # GitHub object
598              
599 0         0 my $pat = $gitHub->patKey(1);
600 0 0       0 my $user = qm $gitHub->userid; $user or confess "userid required";
  0         0  
601 0 0       0 my $repo = qm $gitHub->repository; $repo or confess "repository required";
  0         0  
602 0         0 my $url = url;
603              
604 0         0 my $c = qq(curl -si $pat $url/$user/$repo/branches);
605              
606 0         0 my $r = GitHub::Crud::Response::new($gitHub, $c);
607 0         0 my $success = $r->status == 200; # Check response code
608 0 0 0     0 !$success and $gitHub->confessOnFailure and confess dump($gitHub); # Confess to any failure if so requested
609              
610 0         0 $r
611             }
612              
613             sub listCommitShas($) # Create {commit name => sha} from the results of L.
614 0     0 1 0 {my ($commits) = @_; # Commits from L
615              
616 0 0       0 return undef unless my $data = $commits->data; # Commits array
617 0         0 {map {$$_{name} => $$_{commit}{sha}} @$data} # Commits hash
  0         0  
  0         0  
618             }
619              
620             sub writeCommit($$@) # Write all the files in a B<$folder> (or just the the named files) into a L repository in parallel as a commit on the specified branch.\mRequired attributes: L, L, L.
621 0     0 1 0 {my ($gitHub, $folder, @files) = @_; # GitHub object, file prefix to remove, files to write
622              
623 0 0       0 -d $folder or confess "No such folder"; # Folder does not exist
624              
625 0         0 my $pat = $gitHub->patKey(1);
626 0 0       0 my $user = qm $gitHub->userid; $user or confess "userid required";
  0         0  
627 0 0       0 my $repo = qm $gitHub->repository; $repo or confess "repository required";
  0         0  
628 0 0       0 my $bran = $gitHub->branch; $bran or confess "branch required";
  0         0  
629 0         0 my $url = url;
630              
631             my @sha = processFilesInParallel sub # Create blobs for each file
632 0     0   0 {my ($source) = @_;
633 0         0 my $target = $gitHub->gitFile = swapFilePrefix($source, $folder);
634 0         0 [$source, $target, $gitHub->writeBlob(readBinaryFile($source))]
635 0 0       0 }, undef, @files ? @files : searchDirectoryTreesForMatchingFiles($folder);
636              
637             my $tree = sub # Create the tree
638 0     0   0 {my @t;
639 0         0 for my $f(@sha) # Load files into a tree
640 0         0 {my ($s, $t, $b) = @$f;
641 0         0 push @t, <
642             {"path" : "$t",
643             "mode" : "100644",
644             "type" : "blob",
645             "sha" : "$b"
646             }
647             END
648             }
649              
650 0         0 my $t = join ",\n", @t; # Assemble tree
651 0         0 my $j = qq({"tree" : [$t]}); # Json describing tree
652 0         0 my $f = writeTempFile($j); # Write Json
653 0         0 my $c = qq(curl -si -X POST $pat -d \@$f $url/$user/$repo/git/trees);
654              
655 0         0 my $r = GitHub::Crud::Response::new($gitHub, $c);
656 0         0 my $success = $r->status == 201; # Check response code
657 0         0 unlink $f; # Cleanup
658              
659 0 0       0 $success or confess "Unable to create tree: ".dump($r);
660              
661 0         0 $r
662 0         0 }->();
663              
664             my $parents = sub # Prior commits
665 0     0   0 {my %c = listCommitShas $gitHub->listCommits;
666 0         0 my $b = $gitHub->branch;
667 0 0       0 return '' unless my $s = $c{$b};
668 0         0 qq(, "parents" : ["$s"])
669 0         0 }->();
670              
671             my $commit = sub # Create a commit to hold the tree
672 0     0   0 {my $s = $tree->data->sha;
673 0         0 my $d = dateTimeStamp;
674 0         0 my $j = <
675             { "message" : "Committed by GitHub::Crud on: $d"
676             , "tree" : "$s"
677             $parents
678             }
679             END
680 0         0 my $f = writeFile(undef, $j); # Write json
681              
682 0         0 my $c = qq(curl -si -X POST $pat -d \@$f $url/$user/$repo/git/commits); # Execute json
683              
684 0         0 my $r = GitHub::Crud::Response::new($gitHub, $c);
685 0         0 my $success = $r->status == 201; # Check response code
686 0         0 unlink $f; # Cleanup
687              
688 0 0       0 $success or confess "Unable to create commit: ".dump($r);
689              
690 0         0 $r
691 0         0 }->();
692              
693             my $branch = sub # Update branch - if this fails we will try a force as the next step
694 0     0   0 {my $s = $commit->data->sha;
695 0         0 my $f = writeFile(undef, <
696             {
697             "ref": "refs/heads/$bran",
698             "sha": "$s"
699             }
700             END
701 0         0 my $c = qq(curl -si -X POST $pat -d \@$f $url/$user/$repo/git/refs);
702 0         0 my $r = GitHub::Crud::Response::new($gitHub, $c);
703 0         0 my $success = $r->status == 201; # Check response code
704 0         0 unlink $f; # Cleanup
705              
706 0         0 $r
707 0         0 }->();
708              
709 0         0 my $status = $branch->status; # Creation status
710 0 0       0 if ($branch->status == 201) {return $branch} # Branch created
  0 0       0  
711             elsif ($branch->status == 422) # Update existing branch
712             {my $branchUpdate = sub
713 0     0   0 {my $s = $commit->data->sha;
714 0         0 my $f = writeFile(undef, <
715             { "sha": "$s",
716             "force": true
717             }
718             END
719 0         0 my $c = qq(curl -si -X PATCH $pat -d \@$f $url/$user/$repo/git/refs/heads/$bran);
720 0         0 my $r = GitHub::Crud::Response::new($gitHub, $c);
721 0         0 my $success = $r->status == 200; # Check response code
722 0         0 unlink $f; # Cleanup
723              
724 0 0       0 $success or confess "Unable to update branch: ".dump($r);
725              
726 0         0 $r
727 0         0 }->();
728 0         0 return $branchUpdate;
729             }
730              
731 0         0 confess "Unable to create/update branch: $bran";
732             }
733              
734             sub listWebHooks($) # List web hooks associated with your L repository.\mRequired: L, L, L. \mIf the list operation is successful, L is set to false otherwise it is set to true.\mReturns true if the list operation was successful else false.
735 0     0 1 0 {my ($gitHub) = @_; # GitHub object
736 0         0 my $pat = $gitHub->patKey(1);
737 0 0       0 my $user = qm $gitHub->userid; $user or confess "userid required";
  0         0  
738 0 0       0 my $repo = qm $gitHub->repository; $repo or confess "repository required";
  0         0  
739 0         0 my $bran = qm $gitHub->refOrBranch(0);
740 0         0 my $url = url;
741              
742 0         0 my $u = filePath($url, $user, $repo, qw(hooks));
743 0         0 my $s = "curl -si $pat $u";
744 0         0 my $r = GitHub::Crud::Response::new($gitHub, $s);
745 0         0 my $success = $r->status =~ m(200|201); # Present or not present
746 0 0       0 $gitHub->failed = $success ? undef : 1;
747 0 0 0     0 !$success and $gitHub->confessOnFailure and confess dump($gitHub); # Confess to any failure if so requested
748 0 0       0 $success ? $gitHub->response->data : undef # Return reference to array of web hooks on success. If there are no web hooks set then the referenced array will be empty.
749             }
750              
751             sub createPushWebHook($) # Create a web hook for your L userid.\mRequired: L, L, L, L.\mOptional: L.\mIf the create operation is successful, L is set to false otherwise it is set to true.\mReturns true if the web hook was created successfully else false.
752 0     0 1 0 {my ($gitHub) = @_; # GitHub object
753 0         0 my $pat = $gitHub->patKey(1);
754 0 0       0 my $user = qm $gitHub->userid; $user or confess "userid required";
  0         0  
755 0 0       0 my $repo = qm $gitHub->repository; $repo or confess "repository required";
  0         0  
756 0 0       0 my $webUrl = qm $gitHub->webHookUrl; $webUrl or confess "url required";
  0         0  
757 0         0 my $bran = qm $gitHub->refOrBranch(0);
758 0         0 my $secret = $gitHub->secret;
759 0 0       0 my $sj = $secret ? qq(, "secret": "$secret") : ''; # Secret for Json
760 0         0 my $url = url;
761              
762 0 0       0 $webUrl =~ m(\Ahttps?://) or confess # Check that we are using a url like thing for the web hook or complain
763             "Web hook has no scheme, should start with https?:// not:\n$webUrl";
764              
765 0         0 owf(my $tmpFile = temporaryFile(), my $json = <
766             {"name": "web", "active": true, "events": ["push"],
767             "config": {"url": "$webUrl", "content_type": "json" $sj}
768             }
769             END
770 0         0 my $d = q( -d @).$tmpFile;
771 0         0 my $u = filePath($url, $user, $repo, qw(hooks));
772 0         0 my $s = "curl -si -X POST $pat $u $d"; # Create url
773 0         0 my $r = GitHub::Crud::Response::new($gitHub, $s);
774              
775 0         0 my $success = $r->status == 201; # Check response code
776 0         0 unlink $tmpFile; # Cleanup
777 0 0       0 $gitHub->failed = $success ? undef : 1;
778 0 0 0     0 !$success and $gitHub->confessOnFailure and confess dump($gitHub); # Confess to any failure if so requested
779 0 0       0 $success ? 1 : undef # Return true on success
780             }
781              
782             sub listRepositories($) # List the repositories accessible to a user on L.\mRequired: L.\mReturns details of the repositories.
783 0     0 1 0 {my ($gitHub) = @_; # GitHub object
784              
785 0         0 my $pat = $gitHub->patKey(1);
786 0 0       0 my $user = qm $gitHub->userid; $user or confess "userid required";
  0         0  
787 0         0 my $url = api;
788              
789 0         0 my $u = filePath($url, qw(user repos)); # Request url
790 0         0 my $s = "curl -si $pat $u"; # Create url
791 0         0 my $r = GitHub::Crud::Response::new($gitHub, $s);
792 0         0 my $success = $r->status == 200; # Check response code
793 0 0       0 $gitHub->failed = $success ? undef : 1;
794 0 0 0     0 !$success and $gitHub->confessOnFailure and confess dump($gitHub); # Confess to any failure if so requested
795 0 0       0 $success ? $r->data->@* : undef # Return a list of repositories on success
796             }
797              
798             sub createRepository($) # Create a repository on L.\mRequired: L, L.\mReturns true if the issue was created successfully else false.
799 0     0 1 0 {my ($gitHub) = @_; # GitHub object
800 0         0 my $pat = $gitHub->patKey(1);
801 0 0       0 my $user = qm $gitHub->userid; $user or confess "userid required";
  0         0  
802 0 0       0 my $repo = qm $gitHub->repository; $repo or confess "repository required";
  0         0  
803 0 0       0 my $private= $gitHub->private ? q(, "private":true) : q(); # Private or not
804 0         0 my $url = api;
805              
806 0         0 my $json = qq({"name":"$repo", "auto_init":true $private}); # Issue in json
807 0         0 my $tmpFile = writeFile(undef, $json); # Write repo definition
808 0         0 my $d = q( -d @).$tmpFile;
809 0         0 my $u = filePath($url, qw(user repos)); # Request url
810 0         0 my $s = "curl -si -X POST $pat $u $d"; # Create url
811 0         0 my $r = GitHub::Crud::Response::new($gitHub, $s);
812 0         0 my $success = $r->status == 201; # Check response code
813 0         0 unlink $tmpFile; # Cleanup
814 0 0       0 $gitHub->failed = $success ? undef : 1;
815 0 0 0     0 !$success and $gitHub->confessOnFailure and confess dump($gitHub); # Confess to any failure if so requested
816 0 0       0 $success ? 1 : undef # Return true on success
817             }
818              
819             sub createRepositoryFromSavedToken($$;$$) # Create a repository on L using an access token either as supplied or saved in a file using L.\mReturns true if the issue was created successfully else false.
820 0     0 1 0 {my ($userid, $repository, $private, $accessFolderOrToken) = @_; # Userid on GitHub, the repository name, true if the repo is private, location of access token.
821 0         0 my $g = GitHub::Crud::new;
822 0         0 $g->userid = $userid;
823 0         0 $g->repository = $repository;
824 0         0 $g->private = $private;
825 0         0 $g->personalAccessTokenFolder = $accessFolderOrToken;
826 0         0 $g->loadPersonalAccessToken;
827 0         0 $g->confessOnFailure = 0;
828 0         0 $g->createRepository;
829             }
830              
831             sub createIssue($) # Create an issue on L.\mRequired: L, L, L, L.\mIf the operation is successful, L is set to false otherwise it is set to true.\mReturns true if the issue was created successfully else false.
832 0     0 1 0 {my ($gitHub) = @_; # GitHub object
833 0         0 my $pat = $gitHub->patKey(1);
834 0 0       0 my $user = qm $gitHub->userid; $user or confess "userid required";
  0         0  
835 0 0       0 my $repo = qm $gitHub->repository; $repo or confess "repository required";
  0         0  
836 0 0       0 my $body = $gitHub->body; $body or confess "body required";
  0         0  
837 0 0       0 my $title = $gitHub->title; $title or confess "title required";
  0         0  
838 0         0 my $bran = qm $gitHub->refOrBranch(0);
839 0         0 my $url = url;
840              
841 0         0 my $json = encodeJson({body=>$body, title=>$title}); # Issue in json
842 0         0 owf(my $tmpFile = temporaryFile(), $json); # Write issue definition
843 0         0 my $d = q( -d @).$tmpFile;
844 0         0 my $u = filePath($url, $user, $repo, qw(issues));
845 0         0 my $s = "curl -si -X POST $pat $u $d"; # Create url
846 0         0 my $r = GitHub::Crud::Response::new($gitHub, $s);
847 0         0 my $success = $r->status == 201; # Check response code
848 0         0 unlink $tmpFile; # Cleanup
849 0 0       0 $gitHub->failed = $success ? undef : 1;
850 0 0 0     0 !$success and $gitHub->confessOnFailure and # Confess to any failure if so requested
851             confess join "\n", dump($gitHub), $json, $s;
852 0 0       0 $success ? 1 : undef # Return true on success
853             }
854              
855             sub createIssueFromSavedToken($$$$;$) # Create an issue on L using an access token as supplied or saved in a file using L.\mReturns true if the issue was created successfully else false.
856 0     0 1 0 {my ($userid, $repository, $title, $body, $accessFolderOrToken) = @_; # Userid on GitHub, repository name, issue title, issue body, location of access token.
857 0         0 my $g = GitHub::Crud::new;
858 0         0 $g->userid = $userid;
859 0         0 $g->repository = $repository;
860 0         0 $g->title = $title;
861 0         0 $g->body = $body;
862 0         0 $g->personalAccessTokenFolder = $accessFolderOrToken;
863 0         0 $g->loadPersonalAccessToken;
864 0         0 $g->confessOnFailure = 1;
865 0         0 $g->createIssue;
866             }
867              
868             sub currentRepo() # Create a github object for the current repo if we are on github actions
869 0 0   0 1 0 {if (my $r = $ENV{GITHUB_REPOSITORY}) # We are on GitHub
870 0         0 {my ($user, $repo) = split m(/), $r, 2;
871 0         0 my $g = GitHub::Crud::new;
872 0         0 $g->userid = $user;
873 0         0 $g->repository = $repo;
874 0         0 $g->personalAccessToken = $ENV{GITHUB_TOKEN};
875 0         0 $g->confessOnFailure = 1;
876              
877 0 0       0 if (!$g->personalAccessToken)
878 0         0 {confess "Unable to load github token for repository $r from environment variable: GITHUB_TOKEN\nSee: https://github.com/philiprbrenan/postgres/blob/main/.github/workflows/main.yml";
879             }
880              
881 0         0 return $g;
882             }
883             undef
884 0         0 }
885              
886             sub createIssueInCurrentRepo($$) # Create an issue in the current GitHub repo if we are running on GitHub
887 0     0 1 0 {my ($title, $body) = @_; # Title of issue, body of issue
888 0 0       0 if (my $g = currentRepo) # We are on GitHub
889 0         0 {$g->title = $title;
890 0         0 $g->body = $body;
891 0         0 $g->createIssue;
892             }
893             }
894              
895             sub writeFileUsingSavedToken($$$$;$) # Write to a file on L using a personal access token as supplied or saved in a file. Return B<1> on success or confess to any failure.
896 0     0 1 0 {my ($userid, $repository, $file, $content, $accessFolderOrToken) = @_; # Userid on GitHub, repository name, file name on github, file content, location of access token.
897 0         0 my $g = GitHub::Crud::new;
898 0 0       0 $g->userid = $userid; $userid or confess "Userid required";
  0         0  
899 0 0       0 $g->repository = $repository; $repository or confess "Repository required";
  0         0  
900 0 0       0 $g->gitFile = $file; $file or confess "File required";
  0         0  
901 0         0 $g->personalAccessTokenFolder = $accessFolderOrToken;
902 0         0 $g->loadPersonalAccessToken;
903 0         0 $g->write($content);
904             }
905              
906             sub writeFileFromFileUsingSavedToken($$$$;$) # Copy a file to L using a personal access token as supplied or saved in a file. Return B<1> on success or confess to any failure.
907 0     0 1 0 {my ($userid, $repository, $file, $localFile, $accessFolderOrToken) = @_; # Userid on GitHub, repository name, file name on github, file content, location of access token.
908 0         0 writeFileUsingSavedToken($userid, $repository, $file,
909             readBinaryFile($localFile), $accessFolderOrToken);
910             }
911              
912             sub writeFileFromCurrentRun($$) # Write to a file into the repository from the current run
913 0     0 1 0 {my ($target, $text) = @_; # The target file name in the repo, the text to write into this file
914 0 0       0 if (my $g = currentRepo) # We are on GitHub
915 0         0 {$g->gitFile = $target;
916 0         0 $g->write($text);
917             }
918             }
919              
920             sub writeFileFromFileFromCurrentRun($) # Write a file into the repository from the current run
921 0     0 1 0 {my ($target) = @_; # File name both locally and in the repo
922 0 0       0 -e $target or confess "File to upload does not exist:\n$target";
923 0 0       0 if (my $g = currentRepo) # We are on GitHub
924 0         0 {$g->gitFile = $target;
925 0         0 $g->write(scalar(readFile($target)));
926             }
927             }
928              
929             sub writeBinaryFileFromFileInCurrentRun($$) # Upload a binary file from the current run into the repo.
930 0     0 1 0 {my ($target, $source) = @_; # The target file name in the repo, the current file name in the run
931 0 0       0 if (my $g = currentRepo) # We are on GitHub
932 0         0 {$g->gitFile = $target;
933 0         0 $g->write(readBinaryFile($source));
934             }
935             }
936              
937             sub readFileUsingSavedToken($$$;$) # Read from a file on L using a personal access token as supplied or saved in a file. Return the content of the file on success or confess to any failure.
938 0     0 1 0 {my ($userid, $repository, $file, $accessFolderOrToken) = @_; # Userid on GitHub, repository name, file name on github, location of access token.
939 0         0 my $g = GitHub::Crud::new;
940 0         0 $g->userid = $userid;
941 0         0 $g->repository = $repository;
942 0         0 $g->gitFile = $file;
943 0         0 $g->personalAccessTokenFolder = $accessFolderOrToken;
944 0         0 $g->loadPersonalAccessToken;
945 0         0 $g->read;
946             }
947              
948             sub writeFolderUsingSavedToken($$$$;$) # Write all the files in a local folder to a target folder on a named L repository using a personal access token as supplied or saved in a file.
949 0     0 1 0 {my ($userid,$repository,$targetFolder,$localFolder,$accessFolderOrToken) = @_;# Userid on GitHub, repository name, target folder on github, local folder name, location of access token.
950 0         0 my $g = GitHub::Crud::new;
951 0         0 $g->userid = $userid;
952 0         0 $g->repository = $repository;
953 0         0 $g->personalAccessTokenFolder = $accessFolderOrToken;
954 0         0 $g->loadPersonalAccessToken;
955              
956 0         0 for my $file(searchDirectoryTreesForMatchingFiles($localFolder))
957 0         0 {$g->gitFile = swapFilePrefix($file, $localFolder, $targetFolder);
958 0         0 $g->write(readBinaryFile($file));
959             }
960             }
961              
962             sub writeCommitUsingSavedToken($$$;$) # Write all the files in a local folder to a named L repository using a personal access token as supplied or saved in a file.
963 0     0 1 0 {my ($userid, $repository, $source, $accessFolderOrToken) = @_; # Userid on GitHub, repository name, local folder on github, optionally: location of access token.
964 0         0 my $g = GitHub::Crud::new;
965 0         0 $g->userid = $userid;
966 0         0 $g->repository = $repository;
967 0         0 $g->personalAccessTokenFolder = $accessFolderOrToken;
968 0         0 $g->loadPersonalAccessToken;
969 0         0 $g->branch = 'master';
970              
971 0         0 $g->writeCommit($source);
972             }
973              
974             sub deleteFileUsingSavedToken($$$;$) # Delete a file on GitHub using a saved token
975 0     0 1 0 {my ($userid, $repository, $target, $accessFolderOrToken) = @_; # Userid on GitHub, repository name, file on Github, optional: the folder containing saved access tokens
976 0         0 my $g = GitHub::Crud::new;
977 0         0 $g->userid = $userid;
978 0         0 $g->repository = $repository;
979 0         0 $g->personalAccessTokenFolder = $accessFolderOrToken;
980 0         0 $g->loadPersonalAccessToken;
981              
982 0         0 $g->gitFile = $target;
983 0         0 $g->delete;
984             }
985              
986             sub getRepositoryUsingSavedToken($$;$) # Get repository details using a saved token
987 0     0 1 0 {my ($userid, $repository, $accessFolderOrToken) = @_; # Userid on GitHub, repository name, optionally: location of access token.
988 0         0 my $g = GitHub::Crud::new;
989 0 0       0 $g->userid = $userid; $userid or confess "Userid required";
  0         0  
990 0 0       0 $g->repository = $repository; $repository or confess "Repository required";
  0         0  
991 0         0 $g->personalAccessTokenFolder = $accessFolderOrToken;
992 0         0 $g->loadPersonalAccessToken;
993 0         0 $g->getRepository;
994             }
995              
996             sub getRepositoryUpdatedAtUsingSavedToken($$;$) # Get repository 'updated_at' using a saved token and return the time in number of seconds since the Unix epoch.
997 0     0 1 0 {my ($userid, $repository, $accessFolderOrToken) = @_; # Userid on GitHub, repository name, optionally: location of access token.
998 0         0 my $r = &getRepositoryUsingSavedToken(@_); # Get repository details using a saved token
999 0         0 my $u = $r->data->{updated_at};
1000 0         0 return Date::Manip::UnixDate($u,'%s');
1001             }
1002              
1003             #D1 Access tokens # Load and save access tokens. Some L requets must be signed with an L access token. These methods allow you to store and reuse such tokens.
1004              
1005             sub savePersonalAccessToken($) # Save a L personal access token by userid in folder L.
1006 0     0 1 0 {my ($gitHub) = @_; # GitHub object
1007 0 0       0 my $user = qm $gitHub->userid; $user or confess "userid required";
  0         0  
1008 0 0       0 my $pat = $gitHub->personalAccessToken; $pat or confess "personal access token required";
  0         0  
1009 0   0     0 my $dir = $gitHub->personalAccessTokenFolder // accessFolder;
1010 0         0 my $file = filePathExt($dir, $user, q(data));
1011 0         0 makePath($file);
1012 0         0 storeFile($file, {pat=>$pat}); # Store personal access token
1013 0 0       0 -e $file or confess "Unable to store personal access token in file:\n$file"; # Complain if store fails
1014 0         0 my $p = retrieveFile $file; # Retrieve access token to check that we wrote it successfully
1015             $pat eq $p->{pat} or # Check file format
1016 0 0       0 confess "File contains the wrong personal access token:\n$file";
1017             }
1018              
1019             sub loadPersonalAccessToken($) # Load a personal access token by userid from folder L.
1020 0     0 1 0 {my ($gitHub) = @_; # GitHub object
1021 0 0       0 my $user = qm $gitHub->userid; $user or confess "userid required";
  0         0  
1022              
1023 0 0 0     0 if (length($gitHub->personalAccessTokenFolder//accessFolder) == 43) # Access token supplied directly
1024 0         0 {return $gitHub->personalAccessToken = $gitHub->personalAccessTokenFolder;
1025             }
1026              
1027 0 0       0 if ($ENV{GITHUB_TOKEN}) # Access token supplied through environment
1028 0         0 {return $gitHub->personalAccessToken = $ENV{GITHUB_TOKEN};
1029             }
1030              
1031 0   0     0 my $dir = $gitHub->personalAccessTokenFolder // accessFolder;
1032 0         0 my $file = filePathExt($dir, $user, q(data));
1033 0         0 my $p = retrieveFile $file; # Load personal access token
1034             my $a = $p->{pat} or # Check file format
1035 0 0       0 confess "File does not contain a personal access token:\n$file";
1036 0         0 $gitHub->personalAccessToken = $a; # Retrieve token
1037             }
1038              
1039             #D0
1040             #-------------------------------------------------------------------------------
1041             # Export - eeee
1042             #-------------------------------------------------------------------------------
1043              
1044 1     1   9 use Exporter qw(import);
  1         3  
  1         50  
1045              
1046 1     1   8 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  1         2  
  1         474  
1047              
1048             # containingFolder
1049              
1050             @ISA = qw(Exporter);
1051             @EXPORT_OK = qw(
1052             createIssueFromSavedToken
1053             createIssueInCurrentRepo
1054             createRepositoryFromSavedToken
1055             deleteFileUsingSavedToken
1056             getRepository
1057             getRepositoryUsingSavedToken
1058             getRepositoryUpdatedAtUsingSavedToken
1059             readFileUsingSavedToken
1060             writeBinaryFileFromFileInCurrentRun
1061             writeCommitUsingSavedToken
1062             writeFileFromCurrentRun
1063             writeFileFromFileUsingSavedToken
1064             writeFileUsingSavedToken
1065             writeFolderUsingSavedToken
1066             );
1067             %EXPORT_TAGS = (all=>[@EXPORT_OK]);
1068              
1069             #podDocumentation
1070              
1071             =pod
1072              
1073             =encoding utf-8
1074              
1075             =head1 Name
1076              
1077             GitHub::Crud - Create, Read, Update, Delete files, commits, issues, and web hooks on GitHub.
1078              
1079             =head1 Synopsis
1080              
1081             Create, Read, Update, Delete files, commits, issues, and web hooks on GitHub as
1082             described at:
1083              
1084             https://developer.github.com/v3/repos/contents/#update-a-file
1085              
1086             Commit a folder to GitHub then read and check some of the uploaded content:
1087              
1088             use GitHub::Crud;
1089             use Data::Table::Text qw(:all);
1090              
1091             my $f = temporaryFolder; # Folder in which we will create some files to upload in the commit
1092             my $c = dateTimeStamp; # Create some content
1093             my $if = q(/home/phil/.face); # Image file
1094              
1095             writeFile(fpe($f, q(data), $_, qw(txt)), $c) for 1..3; # Place content in files in a sub folder
1096             copyBinaryFile $if, my $If = fpe $f, qw(face jpg); # Add an image
1097              
1098             my $g = GitHub::Crud::new # Create GitHub
1099             (userid => q(philiprbrenan),
1100             repository => q(aaa),
1101             branch => q(test),
1102             confessOnFailure => 1);
1103              
1104             $g->loadPersonalAccessToken; # Load a personal access token
1105             $g->writeCommit($f); # Upload commit - confess to any errors
1106              
1107             my $C = $g->read(q(data/1.txt)); # Read data written in commit
1108             my $I = $g->read(q(face.jpg));
1109             my $i = readBinaryFile $if;
1110              
1111             confess "Date stamp failed" unless $C eq $c; # Check text
1112             confess "Image failed" unless $i eq $I; # Check image
1113             confess "Write commit succeeded";
1114              
1115             =head1 Prerequisites
1116              
1117             sudo apt-get install curl
1118              
1119             =head1 Description
1120              
1121             Create, Read, Update, Delete files, commits, issues, and web hooks on GitHub.
1122              
1123              
1124             Version 20210211.
1125              
1126              
1127             The following sections describe the methods in each functional area of this
1128             module. For an alphabetic listing of all methods by name see L.
1129              
1130              
1131              
1132             =head1 Constructor
1133              
1134             Create a L object with the specified attributes describing the interface with L.
1135              
1136             =head2 new(%attributes)
1137              
1138             Create a new L object with attributes as described at: L.
1139              
1140             Parameter Description
1141             1 %attributes Attribute values
1142              
1143             B
1144              
1145              
1146             my $f = temporaryFolder; # Folder in which we will create some files to upload in the commit
1147             my $c = dateTimeStamp; # Create some content
1148             my $if = q(/home/phil/.face); # Image file
1149              
1150             writeFile(fpe($f, q(data), $_, qw(txt)), $c) for 1..3; # Place content in files in a sub folder
1151             copyBinaryFile $if, my $If = fpe $f, qw(face jpg); # Add an image
1152              
1153              
1154             my $g = GitHub::Crud::new # Create GitHub # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1155              
1156             (userid => q(philiprbrenan),
1157             repository => q(aaa),
1158             branch => q(test),
1159             confessOnFailure => 1);
1160              
1161             $g->loadPersonalAccessToken; # Load a personal access token
1162             $g->writeCommit($f); # Upload commit - confess to any errors
1163              
1164             my $C = $g->read(q(data/1.txt)); # Read data written in commit
1165             my $I = $g->read(q(face.jpg));
1166             my $i = readBinaryFile $if;
1167              
1168             confess "Date stamp failed" unless $C eq $c; # Check text
1169             confess "Image failed" unless $i eq $I; # Check image
1170             success "Write commit succeeded";
1171              
1172              
1173             =head1 Files
1174              
1175             File actions on the contents of L repositories.
1176              
1177             =head2 list($gitHub)
1178              
1179             List all the files contained in a L repository or all the files below a specified folder in the repository.
1180              
1181             Required attributes: L, L.
1182              
1183             Optional attributes: L, L, L, L.
1184              
1185             Use the L parameter to specify the folder to start the list from, by default, the listing will start at the root folder of your repository.
1186              
1187             Use the L option if you require only the files in the start folder as otherwise all the folders in the start folder will be listed as well which might take some time.
1188              
1189             If the list operation is successful, L is set to false and L is set to refer to an array of the file names found.
1190              
1191             If the list operation fails then L is set to true and L is set to refer to an empty array.
1192              
1193             Returns the list of file names found or empty list if no files were found.
1194              
1195             Parameter Description
1196             1 $gitHub GitHub
1197              
1198             B
1199              
1200              
1201              
1202             success "list:", gitHub->list; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1203              
1204              
1205             # list: alpha.data .github/workflows/test.yaml images/aaa.txt images/aaa/bbb.txt # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1206              
1207              
1208              
1209             =head2 specialFileData($d)
1210              
1211             Do not encode or decode data with a known file signature
1212              
1213             Parameter Description
1214             1 $d String to check
1215              
1216             =head2 read($gitHub, $File)
1217              
1218             Read data from a file on L.
1219              
1220             Required attributes: L, L.
1221              
1222             Optional attributes: L = the file to read, L, L.
1223              
1224             If the read operation is successful, L is set to false and L is set to the data read from the file.
1225              
1226             If the read operation fails then L is set to true and L is set to B.
1227              
1228             Returns the data read or B if no file was found.
1229              
1230             Parameter Description
1231             1 $gitHub GitHub
1232             2 $File File o read if not specified in gitFile
1233              
1234             B
1235              
1236              
1237             my $g = gitHub;
1238             $g->gitFile = my $f = q(z'2 'z"z.data);
1239             my $d = q(𝝰𝝱𝝲);
1240             $g->write($d);
1241              
1242             confess "read FAILED" unless $g->read eq $d; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1243              
1244             success "Read passed";
1245              
1246              
1247             =head2 write($gitHub, $data, $File)
1248              
1249             Write utf8 data into a L file.
1250              
1251             Required attributes: L, L, L. Either specify the target file on: using the L attribute or supply it as the third parameter. Returns B on success else L.
1252              
1253             Parameter Description
1254             1 $gitHub GitHub object
1255             2 $data Data to be written
1256             3 $File Optionally the name of the file on github
1257              
1258             B
1259              
1260              
1261             my $g = gitHub;
1262             $g->gitFile = "zzz.data";
1263              
1264             my $d = dateTimeStamp.q( 𝝰𝝱𝝲);
1265              
1266             if (1)
1267             {my $t = time();
1268              
1269             $g->write($d); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1270              
1271              
1272             lll "First write time: ", time() - $t; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1273              
1274             }
1275              
1276             my $r = $g->read;
1277             lll "Write bbb: $r";
1278             if (1)
1279             {my $t = time();
1280              
1281             $g->write($d); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1282              
1283              
1284             lll "Second write time: ", time() - $t; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1285              
1286             }
1287              
1288             confess "write FAILED" unless $g->exists; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1289              
1290             success "Write passed";
1291              
1292              
1293             =head2 readBlob($gitHub, $sha)
1294              
1295             Read a L from L.
1296              
1297             Required attributes: L, L, L. Returns the content of the L identified by the specified L.
1298              
1299             Parameter Description
1300             1 $gitHub GitHub object
1301             2 $sha Data to be written
1302              
1303             B
1304              
1305              
1306             my $g = gitHub;
1307             $g->gitFile = "face.jpg";
1308             my $d = readBinaryFile(q(/home/phil/.face));
1309             my $s = $g->writeBlob($d);
1310             my $S = q(4a2df549febb701ba651aae46e041923e9550cb8);
1311             confess q(Write blob FAILED) unless $s eq $S;
1312              
1313              
1314             my $D = $g->readBlob($s); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1315              
1316             confess q(Write/Read blob FAILED) unless $d eq $D;
1317             success q(Write/Read blob passed);
1318              
1319              
1320             =head2 writeBlob($gitHub, $data)
1321              
1322             Write data into a L as a L that can be referenced by future commits.
1323              
1324             Required attributes: L, L, L. Returns the L of the created L or L in a failure occurred.
1325              
1326             Parameter Description
1327             1 $gitHub GitHub object
1328             2 $data Data to be written
1329              
1330             B
1331              
1332              
1333             my $g = gitHub;
1334             $g->gitFile = "face.jpg";
1335             my $d = readBinaryFile(q(/home/phil/.face));
1336              
1337             my $s = $g->writeBlob($d); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1338              
1339             my $S = q(4a2df549febb701ba651aae46e041923e9550cb8);
1340             confess q(Write blob FAILED) unless $s eq $S;
1341              
1342             my $D = $g->readBlob($s);
1343             confess q(Write/Read blob FAILED) unless $d eq $D;
1344             success q(Write/Read blob passed);
1345              
1346              
1347             =head2 copy($gitHub, $target)
1348              
1349             Copy a source file from one location to another target location in your L repository, overwriting the target file if it already exists.
1350              
1351             Required attributes: L, L, L, L = the file to be copied.
1352              
1353             Optional attributes: L.
1354              
1355             If the write operation is successful, L is set to false otherwise it is set to true.
1356              
1357             Returns B if the write updated the file, B if the write created the file else B if the write failed.
1358              
1359             Parameter Description
1360             1 $gitHub GitHub object
1361             2 $target The name of the file to be created
1362              
1363             B
1364              
1365              
1366             my ($f1, $f2) = ("zzz.data", "zzz2.data");
1367             my $g = gitHub;
1368             $g->gitFile = $f2; $g->delete;
1369             $g->gitFile = $f1;
1370             my $d = dateTimeStamp;
1371             my $w = $g->write($d);
1372              
1373             my $r = $g->copy($f2); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1374              
1375             lll "Copy created: $r";
1376             $g->gitFile = $f2;
1377             my $D = $g->read;
1378             lll "Read ccc: $D";
1379              
1380             confess "copy FAILED" unless $d eq $D; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1381              
1382             success "Copy passed"
1383              
1384              
1385             =head2 exists($gitHub)
1386              
1387             Test whether a file exists on L or not and returns an object including the B and B fields if it does else L.
1388              
1389             Required attributes: L, L, L file to test.
1390              
1391             Optional attributes: L, L.
1392              
1393             Parameter Description
1394             1 $gitHub GitHub object
1395              
1396             B
1397              
1398              
1399             my $g = gitHub;
1400             $g->gitFile = "test4.html";
1401             my $d = dateTimeStamp;
1402             $g->write($d);
1403              
1404             confess "exists FAILED" unless $g->read eq $d; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1405              
1406             $g->delete;
1407              
1408             confess "exists FAILED" if $g->read eq $d; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1409              
1410             success "Exists passed";
1411              
1412              
1413             =head2 rename($gitHub, $target)
1414              
1415             Rename a source file on L if the target file name is not already in use.
1416              
1417             Required attributes: L, L, L, L = the file to be renamed.
1418              
1419             Optional attributes: L.
1420              
1421             Returns the new name of the file B if the rename was successful else B if the rename failed.
1422              
1423             Parameter Description
1424             1 $gitHub GitHub object
1425             2 $target The new name of the file
1426              
1427             B
1428              
1429              
1430             my ($f1, $f2) = qw(zzz.data zzz2.data);
1431             my $g = gitHub;
1432             $g->gitFile = $f2; $g->delete;
1433              
1434             my $d = dateTimeStamp;
1435             $g->gitFile = $f1;
1436             $g->write($d);
1437              
1438             confess "rename FAILED" unless $g->read eq $d; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1439              
1440              
1441              
1442             $g->rename($f2); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1443              
1444              
1445             confess "rename FAILED" if $g->exists; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1446              
1447              
1448             $g->gitFile = $f2;
1449              
1450             confess "rename FAILED" if $g->read eq $d; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1451              
1452             success "Rename passed";
1453              
1454              
1455             =head2 delete($gitHub)
1456              
1457             Delete a file from L.
1458              
1459             Required attributes: L, L, L, L = the file to be deleted.
1460              
1461             Optional attributes: L.
1462              
1463             If the delete operation is successful, L is set to false otherwise it is set to true.
1464              
1465             Returns true if the delete was successful else false.
1466              
1467             Parameter Description
1468             1 $gitHub GitHub object
1469              
1470             B
1471              
1472              
1473             my $g = gitHub;
1474             my $d = dateTimeStamp;
1475             $g->gitFile = "zzz.data";
1476             $g->write($d);
1477              
1478              
1479             confess "delete FAILED" unless $g->read eq $d; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1480              
1481              
1482             if (1)
1483             {my $t = time();
1484              
1485             my $d = $g->delete; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1486              
1487             lll "Delete 1: ", $d;
1488              
1489             lll "First delete: ", time() - $t; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1490              
1491              
1492             confess "delete FAILED" if $g->exists; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1493              
1494             }
1495              
1496             if (1)
1497             {my $t = time();
1498              
1499             my $d = $g->delete; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1500              
1501             lll "Delete 1: ", $d;
1502              
1503             lll "Second delete: ", time() - $t; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1504              
1505              
1506             confess "delete FAILED" if $g->exists; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1507              
1508             }
1509             success "Delete passed";
1510              
1511              
1512             =head1 Repositories
1513              
1514             Perform actions on L repositories.
1515              
1516             =head2 getRepository($gitHub)
1517              
1518             Get the overall details of a repository
1519              
1520             Parameter Description
1521             1 $gitHub GitHub object
1522              
1523             B
1524              
1525              
1526              
1527             my $r = gitHub(repository => q(C))->getRepository; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1528              
1529             success "Get repository succeeded";
1530              
1531              
1532             =head2 listCommits($gitHub)
1533              
1534             List all the commits in a L repository.
1535              
1536             Required attributes: L, L.
1537              
1538             Parameter Description
1539             1 $gitHub GitHub object
1540              
1541             B
1542              
1543              
1544              
1545             my $c = gitHub->listCommits; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1546              
1547             my %s = listCommitShas $c;
1548             lll "Commits
1549             ", dump $c;
1550             lll "Commit shas
1551             ", dump \%s;
1552             success "ListCommits passed";
1553              
1554              
1555             =head2 listCommitShas($commits)
1556              
1557             Create {commit name => sha} from the results of L.
1558              
1559             Parameter Description
1560             1 $commits Commits from L
1561              
1562             B
1563              
1564              
1565             my $c = gitHub->listCommits;
1566              
1567             my %s = listCommitShas $c; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1568              
1569             lll "Commits
1570             ", dump $c;
1571             lll "Commit shas
1572             ", dump \%s;
1573             success "ListCommits passed";
1574              
1575              
1576             =head2 writeCommit($gitHub, $folder, @files)
1577              
1578             Write all the files in a B<$folder> (or just the the named files) into a L repository in parallel as a commit on the specified branch.
1579              
1580             Required attributes: L, L, L.
1581              
1582             Parameter Description
1583             1 $gitHub GitHub object
1584             2 $folder File prefix to remove
1585             3 @files Files to write
1586              
1587             B
1588              
1589              
1590             my $f = temporaryFolder; # Folder in which we will create some files to upload in the commit
1591             my $c = dateTimeStamp; # Create some content
1592             my $if = q(/home/phil/.face); # Image file
1593              
1594             writeFile(fpe($f, q(data), $_, qw(txt)), $c) for 1..3; # Place content in files in a sub folder
1595             copyBinaryFile $if, my $If = fpe $f, qw(face jpg); # Add an image
1596              
1597             my $g = GitHub::Crud::new # Create GitHub
1598             (userid => q(philiprbrenan),
1599             repository => q(aaa),
1600             branch => q(test),
1601             confessOnFailure => 1);
1602              
1603             $g->loadPersonalAccessToken; # Load a personal access token
1604              
1605             $g->writeCommit($f); # Upload commit - confess to any errors # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1606              
1607              
1608             my $C = $g->read(q(data/1.txt)); # Read data written in commit
1609             my $I = $g->read(q(face.jpg));
1610             my $i = readBinaryFile $if;
1611              
1612             confess "Date stamp failed" unless $C eq $c; # Check text
1613             confess "Image failed" unless $i eq $I; # Check image
1614             success "Write commit succeeded";
1615              
1616              
1617             =head2 listWebHooks($gitHub)
1618              
1619             List web hooks associated with your L repository.
1620              
1621             Required: L, L, L.
1622              
1623             If the list operation is successful, L is set to false otherwise it is set to true.
1624              
1625             Returns true if the list operation was successful else false.
1626              
1627             Parameter Description
1628             1 $gitHub GitHub object
1629              
1630             B
1631              
1632              
1633              
1634             success join ' ', q(Webhooks:), dump(gitHub->listWebHooks); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1635              
1636              
1637              
1638             =head2 createPushWebHook($gitHub)
1639              
1640             Create a web hook for your L userid.
1641              
1642             Required: L, L, L, L.
1643              
1644             Optional: L.
1645              
1646             If the create operation is successful, L is set to false otherwise it is set to true.
1647              
1648             Returns true if the web hook was created successfully else false.
1649              
1650             Parameter Description
1651             1 $gitHub GitHub object
1652              
1653             B
1654              
1655              
1656             my $g = gitHub;
1657              
1658             my $d = $g->createPushWebHook; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1659              
1660             success join ' ', "Create web hook:", dump($d);
1661              
1662              
1663             =head2 listRepositories($gitHub)
1664              
1665             List the repositories accessible to a user on L.
1666              
1667             Required: L.
1668              
1669             Returns details of the repositories.
1670              
1671             Parameter Description
1672             1 $gitHub GitHub object
1673              
1674             B
1675              
1676              
1677              
1678             success "List repositories: ", dump(gitHub()->listRepositories); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1679              
1680              
1681              
1682             =head2 createRepository($gitHub)
1683              
1684             Create a repository on L.
1685              
1686             Required: L, L.
1687              
1688             Returns true if the issue was created successfully else false.
1689              
1690             Parameter Description
1691             1 $gitHub GitHub object
1692              
1693             B
1694              
1695              
1696              
1697             gitHub(repository => q(ccc))->createRepository; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1698              
1699             success "Create repository succeeded";
1700              
1701              
1702             =head2 createRepositoryFromSavedToken($userid, $repository, $private, $accessFolderOrToken)
1703              
1704             Create a repository on L using an access token either as supplied or saved in a file using L.
1705              
1706             Returns true if the issue was created successfully else false.
1707              
1708             Parameter Description
1709             1 $userid Userid on GitHub
1710             2 $repository The repository name
1711             3 $private True if the repo is private
1712             4 $accessFolderOrToken Location of access token.
1713              
1714             B
1715              
1716              
1717              
1718             createRepositoryFromSavedToken(q(philiprbrenan), q(ddd)); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1719              
1720             success "Create repository succeeded";
1721              
1722              
1723             =head2 createIssue($gitHub)
1724              
1725             Create an issue on L.
1726              
1727             Required: L, L, L, L.
1728              
1729             If the operation is successful, L is set to false otherwise it is set to true.
1730              
1731             Returns true if the issue was created successfully else false.
1732              
1733             Parameter Description
1734             1 $gitHub GitHub object
1735              
1736             B
1737              
1738              
1739              
1740             gitHub(title=>q(Hello), body=>q(World))->createIssue; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1741              
1742             success "Create issue succeeded";
1743              
1744              
1745             =head2 createIssueFromSavedToken($userid, $repository, $title, $body, $accessFolderOrToken)
1746              
1747             Create an issue on L using an access token as supplied or saved in a file using L.
1748              
1749             Returns true if the issue was created successfully else false.
1750              
1751             Parameter Description
1752             1 $userid Userid on GitHub
1753             2 $repository Repository name
1754             3 $title Issue title
1755             4 $body Issue body
1756             5 $accessFolderOrToken Location of access token.
1757              
1758             B
1759              
1760              
1761              
1762             &createIssueFromSavedToken(qw(philiprbrenan ddd hello World)); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1763              
1764             success "Create issue succeeded";
1765              
1766              
1767             =head2 currentRepo()
1768              
1769             Create a github object for the current repo if we are on github actions
1770              
1771              
1772             =head2 createIssueInCurrentRepo($title, $body)
1773              
1774             Create an issue in the current GitHub repo if we are running on GitHub
1775              
1776             Parameter Description
1777             1 $title Title of issue
1778             2 $body Body of issue
1779              
1780             =head2 writeFileUsingSavedToken($userid, $repository, $file, $content, $accessFolderOrToken)
1781              
1782             Write to a file on L using a personal access token as supplied or saved in a file. Return B<1> on success or confess to any failure.
1783              
1784             Parameter Description
1785             1 $userid Userid on GitHub
1786             2 $repository Repository name
1787             3 $file File name on github
1788             4 $content File content
1789             5 $accessFolderOrToken Location of access token.
1790              
1791             B
1792              
1793              
1794             my $s = q(HelloWorld);
1795              
1796             &writeFileUsingSavedToken(qw(philiprbrenan ddd hello.txt), $s); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1797              
1798             my $S = gitHub(repository=>q(ddd), gitFile=>q(hello.txt))->read;
1799              
1800             confess "Write file using saved token FAILED" unless $s eq $S;
1801             success "Write file using saved token succeeded";
1802              
1803              
1804             =head2 writeFileFromFileUsingSavedToken($userid, $repository, $file, $localFile, $accessFolderOrToken)
1805              
1806             Copy a file to L using a personal access token as supplied or saved in a file. Return B<1> on success or confess to any failure.
1807              
1808             Parameter Description
1809             1 $userid Userid on GitHub
1810             2 $repository Repository name
1811             3 $file File name on github
1812             4 $localFile File content
1813             5 $accessFolderOrToken Location of access token.
1814              
1815             B
1816              
1817              
1818             my $f = writeFile(undef, my $s = "World
1819             ");
1820              
1821             &writeFileFromFileUsingSavedToken(qw(philiprbrenan ddd hello.txt), $f); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1822              
1823             my $S = gitHub(repository=>q(ddd), gitFile=>q(hello.txt))->read;
1824             confess "Write file from file using saved token FAILED" unless $s eq $S;
1825             success "Write file from file using saved token succeeded"
1826              
1827              
1828             =head2 writeFileFromCurrentRun($target, $text)
1829              
1830             Write to a file into the repository from the current run
1831              
1832             Parameter Description
1833             1 $target The target file name in the repo
1834             2 $text The text to write into this file
1835              
1836             =head2 writeFileFromFileFromCurrentRun($target)
1837              
1838             Write a file into the repository from the current run
1839              
1840             Parameter Description
1841             1 $target File name both locally and in the repo
1842              
1843             =head2 writeBinaryFileFromFileInCurrentRun($target, $source)
1844              
1845             Upload a binary file from the current run into the repo.
1846              
1847             Parameter Description
1848             1 $target The target file name in the repo
1849             2 $source The current file name in the run
1850              
1851             =head2 readFileUsingSavedToken($userid, $repository, $file, $accessFolderOrToken)
1852              
1853             Read from a file on L using a personal access token as supplied or saved in a file. Return the content of the file on success or confess to any failure.
1854              
1855             Parameter Description
1856             1 $userid Userid on GitHub
1857             2 $repository Repository name
1858             3 $file File name on github
1859             4 $accessFolderOrToken Location of access token.
1860              
1861             B
1862              
1863              
1864             my $s = q(Hello to the World);
1865             &writeFileUsingSavedToken(qw(philiprbrenan ddd hello.txt), $s);
1866              
1867             my $S = &readFileUsingSavedToken (qw(philiprbrenan ddd hello.txt)); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1868              
1869              
1870             confess "Read file using saved token FAILED" unless $s eq $S;
1871             success "Read file using saved token succeeded"
1872              
1873              
1874             =head2 writeFolderUsingSavedToken($userid, $repository, $targetFolder, $localFolder, $accessFolderOrToken)
1875              
1876             Write all the files in a local folder to a target folder on a named L repository using a personal access token as supplied or saved in a file.
1877              
1878             Parameter Description
1879             1 $userid Userid on GitHub
1880             2 $repository Repository name
1881             3 $targetFolder Target folder on github
1882             4 $localFolder Local folder name
1883             5 $accessFolderOrToken Location of access token.
1884              
1885             =head2 writeCommitUsingSavedToken($userid, $repository, $source, $accessFolderOrToken)
1886              
1887             Write all the files in a local folder to a named L repository using a personal access token as supplied or saved in a file.
1888              
1889             Parameter Description
1890             1 $userid Userid on GitHub
1891             2 $repository Repository name
1892             3 $source Local folder on github
1893             4 $accessFolderOrToken Optionally: location of access token.
1894              
1895             =head2 deleteFileUsingSavedToken($userid, $repository, $target, $accessFolderOrToken)
1896              
1897             Delete a file on GitHub using a saved token
1898              
1899             Parameter Description
1900             1 $userid Userid on GitHub
1901             2 $repository Repository name
1902             3 $target File on Github
1903             4 $accessFolderOrToken Optional: the folder containing saved access tokens
1904              
1905             =head2 getRepositoryUsingSavedToken($userid, $repository, $accessFolderOrToken)
1906              
1907             Get repository details using a saved token
1908              
1909             Parameter Description
1910             1 $userid Userid on GitHub
1911             2 $repository Repository name
1912             3 $accessFolderOrToken Optionally: location of access token.
1913              
1914             B
1915              
1916              
1917              
1918             my $r = getRepositoryUsingSavedToken(q(philiprbrenan), q(aaa)); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1919              
1920             success "Get repository using saved access token succeeded";
1921              
1922              
1923             =head2 getRepositoryUpdatedAtUsingSavedToken($userid, $repository, $accessFolderOrToken)
1924              
1925             Get repository 'updated_at' using a saved token and return the time in number of seconds since the Unix epoch.
1926              
1927             Parameter Description
1928             1 $userid Userid on GitHub
1929             2 $repository Repository name
1930             3 $accessFolderOrToken Optionally: location of access token.
1931              
1932             B
1933              
1934              
1935              
1936             my $u = getRepositoryUpdatedAtUsingSavedToken(q(philiprbrenan), q(aaa)); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1937              
1938             success "Get repository updated_at field succeeded";
1939              
1940              
1941             =head1 Access tokens
1942              
1943             Load and save access tokens. Some L requets must be signed with an L access token. These methods allow you to store and reuse such tokens.
1944              
1945             =head2 savePersonalAccessToken($gitHub)
1946              
1947             Save a L personal access token by userid in folder L.
1948              
1949             Parameter Description
1950             1 $gitHub GitHub object
1951              
1952             B
1953              
1954              
1955             my $d = temporaryFolder;
1956             my $t = join '', 1..20;
1957              
1958             my $g = gitHub
1959             (userid => q(philiprbrenan),
1960             personalAccessToken => $t,
1961             personalAccessTokenFolder => $d,
1962             );
1963              
1964              
1965             $g->savePersonalAccessToken; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1966              
1967             my $T = $g->loadPersonalAccessToken;
1968              
1969             confess "Load/Save token FAILED" unless $t eq $T;
1970             success "Load/Save token succeeded"
1971              
1972              
1973             =head2 loadPersonalAccessToken($gitHub)
1974              
1975             Load a personal access token by userid from folder L.
1976              
1977             Parameter Description
1978             1 $gitHub GitHub object
1979              
1980             B
1981              
1982              
1983             my $d = temporaryFolder;
1984             my $t = join '', 1..20;
1985              
1986             my $g = gitHub
1987             (userid => q(philiprbrenan),
1988             personalAccessToken => $t,
1989             personalAccessTokenFolder => $d,
1990             );
1991              
1992             $g->savePersonalAccessToken;
1993              
1994             my $T = $g->loadPersonalAccessToken; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1995              
1996              
1997             confess "Load/Save token FAILED" unless $t eq $T;
1998             success "Load/Save token succeeded"
1999              
2000              
2001              
2002             =head2 GitHub::Crud Definition
2003              
2004              
2005             Attributes describing the interface with L.
2006              
2007              
2008              
2009              
2010             =head3 Input fields
2011              
2012              
2013             =head4 body
2014              
2015             The body of an issue.
2016              
2017             =head4 branch
2018              
2019             Branch name (you should create this branch first) or omit it for the default branch which is usually 'master'.
2020              
2021             =head4 confessOnFailure
2022              
2023             Confess to any failures
2024              
2025             =head4 gitFile
2026              
2027             File name on L - this name can contain '/'. This is the file to be read from, written to, copied from, checked for existence or deleted.
2028              
2029             =head4 gitFolder
2030              
2031             Folder name on L - this name can contain '/'.
2032              
2033             =head4 message
2034              
2035             Optional commit message
2036              
2037             =head4 nonRecursive
2038              
2039             Fetch only one level of files with L.
2040              
2041             =head4 personalAccessToken
2042              
2043             A personal access token with scope "public_repo" as generated on page: https://github.com/settings/tokens.
2044              
2045             =head4 personalAccessTokenFolder
2046              
2047             The folder into which to save personal access tokens. Set to q(/etc/GitHubCrudPersonalAccessToken) by default.
2048              
2049             =head4 private
2050              
2051             Whether the repository being created should be private or not.
2052              
2053             =head4 repository
2054              
2055             The name of the repository to be worked on minus the userid - you should create this repository first manually.
2056              
2057             =head4 secret
2058              
2059             The secret for a web hook - this is created by the creator of the web hook and remembered by L,
2060              
2061             =head4 title
2062              
2063             The title of an issue.
2064              
2065             =head4 userid
2066              
2067             Userid on L of the repository to be worked on.
2068              
2069             =head4 webHookUrl
2070              
2071             The url for a web hook.
2072              
2073              
2074              
2075             =head3 Output fields
2076              
2077              
2078             =head4 failed
2079              
2080             Defined if the last request to L failed else B.
2081              
2082             =head4 fileList
2083              
2084             Reference to an array of files produced by L.
2085              
2086             =head4 readData
2087              
2088             Data produced by L.
2089              
2090             =head4 response
2091              
2092             A reference to L's response to the latest request.
2093              
2094              
2095              
2096             =head2 GitHub::Crud::Response Definition
2097              
2098              
2099             Attributes describing a response from L.
2100              
2101              
2102              
2103              
2104             =head3 Output fields
2105              
2106              
2107             =head4 content
2108              
2109             The actual content of the file from L.
2110              
2111             =head4 data
2112              
2113             The data received from L, normally in L format.
2114              
2115             =head4 status
2116              
2117             Our version of Status.
2118              
2119              
2120              
2121             =head1 Index
2122              
2123              
2124             1 L - Copy a source file from one location to another target location in your L repository, overwriting the target file if it already exists.
2125              
2126             2 L - Create an issue on L.
2127              
2128             3 L - Create an issue on L using an access token as supplied or saved in a file using L.
2129              
2130             4 L - Create an issue in the current GitHub repo if we are running on GitHub
2131              
2132             5 L - Create a web hook for your L userid.
2133              
2134             6 L - Create a repository on L.
2135              
2136             7 L - Create a repository on L using an access token either as supplied or saved in a file using L.
2137              
2138             8 L - Create a github object for the current repo if we are on github actions
2139              
2140             9 L - Delete a file from L.
2141              
2142             10 L - Delete a file on GitHub using a saved token
2143              
2144             11 L - Test whether a file exists on L or not and returns an object including the B and B fields if it does else L.
2145              
2146             12 L - Get the overall details of a repository
2147              
2148             13 L - Get repository 'updated_at' using a saved token and return the time in number of seconds since the Unix epoch.
2149              
2150             14 L - Get repository details using a saved token
2151              
2152             15 L - List all the files contained in a L repository or all the files below a specified folder in the repository.
2153              
2154             16 L - List all the commits in a L repository.
2155              
2156             17 L - Create {commit name => sha} from the results of L.
2157              
2158             18 L - List the repositories accessible to a user on L.
2159              
2160             19 L - List web hooks associated with your L repository.
2161              
2162             20 L - Load a personal access token by userid from folder L.
2163              
2164             21 L - Create a new L object with attributes as described at: L.
2165              
2166             22 L - Read data from a file on L.
2167              
2168             23 L - Read a L from L.
2169              
2170             24 L - Read from a file on L using a personal access token as supplied or saved in a file.
2171              
2172             25 L - Rename a source file on L if the target file name is not already in use.
2173              
2174             26 L - Save a L personal access token by userid in folder L.
2175              
2176             27 L - Do not encode or decode data with a known file signature
2177              
2178             28 L - Write utf8 data into a L file.
2179              
2180             29 L - Upload a binary file from the current run into the repo.
2181              
2182             30 L - Write data into a L as a L that can be referenced by future commits.
2183              
2184             31 L - Write all the files in a B<$folder> (or just the the named files) into a L repository in parallel as a commit on the specified branch.
2185              
2186             32 L - Write all the files in a local folder to a named L repository using a personal access token as supplied or saved in a file.
2187              
2188             33 L - Write to a file into the repository from the current run
2189              
2190             34 L - Write a file into the repository from the current run
2191              
2192             35 L - Copy a file to L using a personal access token as supplied or saved in a file.
2193              
2194             36 L - Write to a file on L using a personal access token as supplied or saved in a file.
2195              
2196             37 L - Write all the files in a local folder to a target folder on a named L repository using a personal access token as supplied or saved in a file.
2197              
2198             =head1 Installation
2199              
2200             This module is written in 100% Pure Perl and, thus, it is easy to read,
2201             comprehend, use, modify and install via B:
2202              
2203             sudo cpan install GitHub::Crud
2204              
2205             =head1 Author
2206              
2207             L
2208              
2209             L
2210              
2211             =head1 Copyright
2212              
2213             Copyright (c) 2016-2021 Philip R Brenan.
2214              
2215             This module is free software. It may be used, redistributed and/or modified
2216             under the same terms as Perl itself.
2217              
2218             =cut
2219              
2220              
2221              
2222             # Tests and documentation
2223              
2224             sub test
2225 1     1 0 9 {my $p = __PACKAGE__;
2226 1         10 binmode($_, ":utf8") for *STDOUT, *STDERR;
2227 1 50       60 return if eval "eof(${p}::DATA)";
2228 1         48 my $s = eval "join('', <${p}::DATA>)";
2229 1 50       9 $@ and die $@;
2230 1     1 0 674 eval $s;
  1     0   65883  
  1         9  
  1         74  
  0            
2231 1 50       5 $@ and die $@;
2232 1         133 1
2233             }
2234              
2235             test unless caller;
2236              
2237             1;
2238             #podDocumentation
2239             __DATA__