view release on metacpan or  search on metacpan

lib/GitHub/Crud.pm  view on Meta::CPAN

    userid                       => undef,                                      #I Userid on L<GitHub> of the repository to be worked on.
   );

  $g->$_ = $attributes{$_} for sort keys %attributes;

  $g
 }

#D1 Files                                                                       # File actions on the contents of L<GitHub> repositories.

sub list($)                                                                     # List all the files contained in a L<GitHub> repository or all the files below a specified folder in the repository.\mRequired attributes: L<userid|/userid>, L<repositor...
 {my ($gitHub) = @_;                                                            # GitHub
  my $r = sub                                                                   # Get contents
   {my $user = qm $gitHub->userid;     $user or confess "userid required";
    my $repo = qm $gitHub->repository; $repo or confess "repository required";
    my $path = qm $gitHub->gitFolder || '';
    my $bran = qm $gitHub->refOrBranch(1);
    my $pat  = $gitHub->patKey(0);
    my $url  = url;
    my $s = filePath
     ("curl -si $pat $url", $user, $repo, qq(contents), $path.$bran);
    GitHub::Crud::Response::new($gitHub, $s);
   }->();

  my $failed = $gitHub->failed = $r->status != 200;                             # Check response code
  $failed and $gitHub->confessOnFailure and confess dump($gitHub);              # Confess to any failure if so requested

  $gitHub->fileList = [];
  if (!$failed and reftype($r->data) =~ m(array)i)                              # Array of file  details
   {for(@{$r->data})                                                            # Objectify and save L<sha> digests from file descriptions retrieved by this call
     {bless $_, "GitHub::Crud::Response::Data";
      saveSha($gitHub, $_);
     }

    my $path = $gitHub->gitFolder || '';
    my @d = map{filePath $path, $_->name} grep {$_->type eq "dir"}  @{$r->data};# Folders
    my @f = map{filePath $path, $_->name} grep {$_->type eq "file"} @{$r->data};# Files

    unless($gitHub->nonRecursive)                                               # Get the contents of sub folders unless otherwise specified
     {for my $d(@d)
       {my $p = $gitHub->gitFolder = $d;
        push @f, $gitHub->list;
       }
     }
    $gitHub->gitFolder = $path;                                                 # Restore path supplied by the user
    $gitHub->fileList  = [@f];                                                  # List of files not directories
   }
  @{$gitHub->fileList}
 }

sub specialFileData($)                                                          # Do not encode or decode data with a known file signature
 {my ($d) = @_;                                                                 # String to check
  my $h = '';
  if ($d and length($d) > 8)                                                    # Read file magic number
   {for my $e(0..7)
     {$h .= sprintf("%x", ord(substr($d, $e, 1)));
     }
    return 1 if $h =~ m(\A504b)i;                                               # PK Zip
    return 1 if $h =~ m(\Ad0cf11e0)i;                                           # OLE files
    return 1 if $h =~ m(\Affd8ff)i;                                             # Jpg
    return 1 if $h =~ m(\A89504e470d0a1a0a)i;                                   # Png
    return 1 if $h =~ m(\A4D546864)i;                                           # Midi
    return 1 if $h =~ m(\A49443340)i;                                           # Mp3
   }
  0                                                                             # Not a special file
 }

sub read($;$)                                                                   # Read data from a file on L<GitHub>.\mRequired attributes: L<userid|/userid>, L<repository|/repository>.\mOptional attributes: L<gitFile|/gitFile> = the file to read, L<...
 {my ($gitHub, $File) = @_;                                                     # GitHub, file o read if not specified in gitFile

  my $user = qm $gitHub->userid;          $user or confess "userid required";
  my $repo = qm $gitHub->repository;      $repo or confess "repository required";
  my $file = qm($File//$gitHub->gitFile); $file or confess "gitFile required";
  my $bran = qm $gitHub->refOrBranch(1);
  my $pat  = $gitHub->patKey(0);

  my $url  = url;
  my $s = filePath(qq(curl -si $pat $url),
                   $user, $repo, qq(contents), $file.$bran);
  my $r = GitHub::Crud::Response::new($gitHub, $s);                             # Get response from GitHub
  my $failed = $gitHub->failed = $r->status != 200;                             # Check response code
  $failed and $gitHub->confessOnFailure and confess dump($gitHub);              # Confess to any failure if so requested

  if ($failed)                                                                  # Decode data unless read failed
   {$gitHub->readData = undef;
   }
  else                                                                          # Decode data
   {my $d = decodeBase64($r->data->content);
    $gitHub->readData = specialFileData($d) ? $d : decode "UTF8", $d;           # Convert to utf unless a known file format
   }

  $gitHub->readData
 }

sub write($$;$)                                                                 # Write utf8 data into a L<GitHub> file.\mRequired attributes: L<userid|/userid>, L<repository|/repository>, L<patKey|/patKey>. Either specify the target file on:<github>...
 {my ($gitHub, $data, $File) = @_;                                              # GitHub object, data to be written, optionally the name of the file on github

  unless($data)                                                                 # No data supplied so delete the file
   {if ($File)
     {my $file = $gitHub->file;
      $gitHub->file = $File;
      $gitHub->delete;
      $gitHub->file = $file;
     }
    else
     {$gitHub->delete;
     }
    return 'empty';                                                             # Success
   }

  my $pat  = $gitHub->patKey(1);
  my $user = qm $gitHub->userid;          $user or confess "userid required";
  my $repo = qm $gitHub->repository;      $repo or confess "repository required";
  my $file = qm($File//$gitHub->gitFile); $file or confess "gitFile required";
  my $bran = qm $gitHub->refOrBranch(0) || '?';
  my $mess = qm $gitHub->message;

  if (!specialFileData($data))                                                  # Send the data as utf8 unless it is a special file
   {use Encode 'encode';
    $data  = encode('UTF-8', $data);
   }