#!/usr/bin/env perl

our $VERSION = "0.1.10";

# 0.1.10 - 2022.07.03
#        - use HTTP::Tiny instead of curl
# 0.1.9 - 2022.07.03
#       - added tests
# 0.1.8 - 2022.07.03
#       - updated bugtracker link in Makefile.PL
# 0.1.7 - 2022.07.03
#       - added CONTRIBUTING.md
#       - fixed bugtracker in Makefile.PL
# 0.1.6 - 2022.07.03
#       - updated bugtracking/issues link in Makefile.PL
#       - added ChangeLog
# 0.1.5 - 2022.07.02
#       - updated documentation in script/git-perl and README.md to use head1 (head2 looks awful)
# 0.1.4 - 2022.07.02
#       - moved README into README.md, so it can be visible on github and not rendered by metacpan
#       - testing head2 instead of head1 on metacpan/github
# 0.1.3 - 2022.07.02
#       - updated AUTHOR information in README and git-perl
#       - updated link to git-perl from App::Git::Perl
#       - removed required strict and warnings from Makefile.PL
#       - updated Makefile.PL to reflect minimum required Perl version of 5.6.0 (using perlver command)
# 0.1.2 - 2022.07.02
#       - bumped version to 0.1.2, since I forgot to update version in lib/App/Git/Perl.pm
# 0.1.1 - 2022.07.02
#       - remove "use strict", and "use warnings"
#       - updated documentation in README and script/git-perl to show 'git-perl' and not 'git' in metacpan
# 0.1.0 - 2022.07.02
#       - initial commit

my $configfile = "$ENV{HOME}/.config/git-perl.conf";
my $gitdirs;

# init
$gitdirs = config("dir");
$gitdirs = "." if ( not $gitdirs );
system("mkdir -p \"$gitdirs\"") if ( not -d $gitdirs );

sub logger {
  print "LOG: @_\n";
}

sub usage {
  print <<"EOF";

git-perl $VERSION

Created to make you easier to monitor latest changes in perl modules, and make you collaborate faster.
Just put it somewhere in your \$PATH, and call like "git perl".

Prepared by Nedzad Hrnjica.

Usage:

  git perl recent                                     = shows recent list of changes from https://metacpan.org/recent
  git perl log BAYASHI/Object-Container-0.16          = git clone repository and show latest changes
  git perl log BAYASHI/Object-Container-0.16 remove   = remove cloned repository
  git perl log Log::Any                               = git clone repository and show latest changes
  git perl log Log::Any remove                        = remove cloned repository
  git perl clone BAYASHI/Object-Container-0.16        = git clone repository
  git perl clone BAYASHI/Object-Container-0.16 remove = remove cloned repository
  git perl clone Log::Any                             = git clone repository
  git perl clone Log::Any remove                      = remove cloned repository
  git perl local                                      = list cloned repositories
  git perl local object-container-perl                = list cloned repository 'object-container-perl'
  git perl local object-container-perl log            = show latest changes in repository
  git perl local object-container-perl remove         = remove local repository stored in 'object-container-perl'
  git perl local Log::Any                             = git clone repository ( get remote repository locally )
  git perl local Log::Any remove                      = remove cloned repository

  git perl config                                     = show current config ( from ~/.config/git-perl.conf )
  git perl config dir                                 = show value of 'dir' from config
  git perl config dir ~/git/perl                      = set value of 'dir' to '~/git/perl'
  git perl config --unset dir                         = remove variable 'dir' from config file

EOF

}

sub httpget {
  use HTTP::Tiny;

  my $url = shift;
  return "" if not $url;

  my $response = HTTP::Tiny->new->get( $url );

  if ( length $response->{content} ) {
    return $response->{content}
  }

  return "";
}

sub config {
  my ($name,$value) = (shift,shift);

  if ( not $name ) {
    # git perl config
    # show all values from ~/.config/git-perl.conf
    my $output = qx{ cat "$configfile" 2>/dev/null };
    chomp($output);
    return $output;
  }

  if ( not $value ) {
    # git perl config 'something'
    # show value for 'something' from ~/.config/git-perl.conf
    my $value = qx{ cat "$configfile" 2>/dev/null | grep "^$name=" | cut -d"=" -f2- };
    chomp($value);
    return $value;
  }

  # unset ?
  my $unset = 0;
  if ( $name eq "--unset" ) {
    $unset = 1;
    $name = $value;
  }

  # If $name and $value

  if ( $name and $value ) {
    # set value
    qx{ mkdir -p "$ENV{HOME}/.config/" };
    qx{ cat "$configfile" | grep -v "^$name=" > "$configfile" };
    qx{ echo "$name=$value" >> "$configfile" } if ( not $unset );
    return "";
  }

}

sub clone {
  my $module = shift;
  return if ( not $module );

  my $url;
  if ( $module =~ /::/ ) {
    $url = "https://metacpan.org/pod/$module";
  } else {
    logger("Getting https://metacpan.org endpoint for '$module'...");

    my $test = httpget("https://metacpan.org/recent");
    my $urlpart = "";
    my @records = split("<tr", $test);
    foreach my $record (@records) {
      if ( $record =~ /a href="([^"]*)".*${module}/s ) {
        $urlpart = $1;
        last;
      }
    }

    $url = "https://metacpan.org${urlpart}";
    logger("URL: [$url]");
  }

  logger("Getting repository details from '$url'...");

  my $test = httpget( $url );
  my $repository = "";
  #my @records = split("<a", $test);
  #foreach my $record (@records) {
  foreach my $record ( split("<a", $test) ) {
    if ( $record =~ / href="([^"]*)".*>Repository</s ) {
      $repository = $1;
      last;
    }
  }

  logger("REPOSITORY: [$repository]");
  if ( not $repository ) {
    logger("ERROR: Respository for module '$module' does not exist!");
    return;
  }

  logger("Cloning remote repository '$repository'...");
  qx{ mkdir -p "${gitdirs}" };
  my $clonetext = qx{ cd ${gitdirs}; git clone "$repository" 2>&1 };
  my ($subdir) = $clonetext =~ /Cloning into '(.*)'/;
  logger("CLONED: [$clonetext]");
  $subdir = "" if ( $subdir and not -d "$gitdirs/$subdir" );
  if ( $subdir ) {
    logger("Cloned into: [$subdir]");
  } else {
    ($subdir) = $clonetext =~ /destination path '(.*)' already exists/;
    logger("Cloned repository already exists in: [$subdir]") if ( $subdir );
  }

  return $subdir;
}

sub remove {
  my $subdir = shift;
  return if ( not $subdir );
  if ( not -d "$gitdirs/$subdir") {
    logger("ERROR: Subdir '$subdir' does not exist!");
    return;
  }

  # $subdir should be OK, when getting it from GIT. But ...
  # make sure that $subdir is not dangerous
  $subdir =~ s#/$##;  # remove last '/' if this is direct reference to subdir
  $subdir =~ s#.*/##; # remove any path element from $subdir
  $subdir = "" if ( $subdir eq "." );  # prevent removing current dir
  $subdir = "" if ( $subdir eq ".." ); # prevent removing parent dir
  my $removed = 0;
  if ( $subdir and -d "$gitdirs/$subdir" ) {
    system( "rm -fr \"$gitdirs/$subdir\"" ); # DANGEROUS !?
    $removed = 1;
  }
  if ( $removed and ! -d "$gitdirs/$subdir" ) {
    print "Removed repository stored in subdir '$subdir'.\n";
  } else {
    print "ERROR: Unable to remove repository subdir '$subdir'!\n";
  }
}

sub gitlog {
  my $module = shift;
  return if ( not $module );
  my $subcommand = shift;

  my $subdir = "";

  # If we want to see log from already cloned subdirectory (as output from 'git perl local')
  if ( -d "$gitdirs/$module" ) {
    $subdir = $module;
  }

  # If that is not local subdir, get it from repository
  if ( not $subdir ) {
    # Clone repostiory locally, or get '$subdir' where it is cloned already
    $subdir = clone($module);
    return if ( not $subdir );
  }

  # If user ask local repository to be removed, do so.
  my $removed = 0;
  if ( $subcommand and $subcommand eq "remove" ) {
    logger("About to remove subdir for module '$module'...");
    remove( $subdir );
    return;
  }

  # Get lastlog and show all changes since last tag
  # If no tags used, show all changes since epoch
  my $lasttag = qx{ cd "$gitdirs/$subdir"; git tag -l | tail -n 2 | head -n 1 };
  chomp($lasttag);
  logger("Last tag: [$lasttag]");
  if ( $lasttag ) {
    system("cd \"$gitdirs/$subdir\"; git log -p ${lasttag}..HEAD");
  } else {
    system("cd \"$gitdirs/$subdir\"; git log -p");
  }

  # Repository will stay locally, so inform user.
  print "Cloned into: $subdir\n";
}

sub main {
  my $command = shift;

  if ( not $command ) {
    usage();
    exit;
  }

  if ( $command eq "recent" ) {

    # get a list of recent repositories

    my $test = httpget("https://metacpan.org/recent");
    my @repositories;
    my @records = split("<tr", $test);
    foreach my $record (@records) {
      if ( $record =~ /title="([^"]*)".* sort="([^"]*)"/s ) {
        push( @repositories, "$2 $1" );
      }
    }
    @repositories = reverse @repositories;
    print join("\n", @repositories, "");

    exit;
  }

  if ( $command eq "clone" ) {
    my $module = shift;
    exit if ( not $module );

    # Clone repostiory locally, or get '$subdir' where it is cloned already
    my $subdir = clone($module);
    return if ( not $subdir );

    print "Cloned into: $subdir\n";

    my ($subcommand) = shift;
    if ( $subcommand and $subcommand eq "remove" ) {
      remove( $subdir );
    }

    exit;
  }

  if ( $command eq "log" ) {
    my $module = shift;
    exit if ( not $module );

    # Call gitlog for $module, and add additional parameter if asked by user (e.g. 'remove')
    gitlog($module,shift);

    exit;
  }

  if ( $command eq "local" ) {
    my ($subdir, $subcommand) = (shift,shift);
    $subdir =~ s#/$## if ( $subdir ); # remove trailing '/' if provided as $subdir
    if ( $subdir and not -d "$gitdirs/$subdir" ) {
      my $newsubdir = clone( $subdir ); # it suppose the '$subdir' is actually '$modulename'
      $subdir = $newsubdir if ( $newsubdir ); # if cloned, use it
    }
    if ( $subdir and $subcommand ) {
      if ( $subcommand eq "remove" ) {
        remove( $subdir );
        exit;
      }
      if ( $subcommand eq "log" ) {
        gitlog( $subdir );
        exit;
      }
    }
    my @local = qx{ cd "${gitdirs}"; ls -1 */dist.ini */Makefile.PL 2>/dev/null | cut -d"/" -f1 | sort | uniq };
    chomp( @local );
    foreach my $local (@local) {
      # If user provided subdir, return data only for that module
      if ( $subdir ) {
        next if ( $local !~ /$subdir/ );
      }
      my $modulefile = "";
      my $module = "";
      my $VERSION = "";

      # Makefile.PL
      $modulefile = qx{ cd "${gitdirs}"; grep VERSION_FROM "$local/Makefile.PL" 2>/dev/null | grep "=>" | cut -d"=" -f2 | cut -d\\' -f2 | cut -d\\" -f2 | sed -e "s#^#$local/#" };
      chomp( $modulefile );
      if ( not $modulefile ) {
        $modulefile = qx{ cd "${gitdirs}"; find "$local/lib" -iname "*.pm" 2>/dev/null | xargs grep -H "package " | sed -e "s/.pm:.*/.pm/" | head -n 1 };
        chomp( $modulefile );
      }
      if ( $modulefile ) {
        $module = qx{ cd "${gitdirs}"; cat "$modulefile" | grep "package " | sed -e "s/package //" | cut -d";" -f1 | head -n 1 };
        chomp( $module );
        if ( not $module ) {
          $module = $modulefile;
        }
        $VERSION = qx{ cd "${gitdirs}"; cat "$modulefile" | grep VERSION | grep "[0-9]" | cut -d\\' -f2 | cut -d\\" -f2 | head -n 1 };
        chomp( $VERSION );
      } else {
        # This is just guessing. It returns our...VERSION from first found file.
        $module = qx{ cd "${gitdirs}"; cd "$local/" ; grep -rsn VERSION * | grep our | cut -d":" -f1 };
        chomp( $module );
        $VERSION = qx{ cd "${gitdirs}"; cd "$local/" ; grep -rsn VERSION * | grep our | cut -d\\' -f2 | cut -d\\" -f2 | head -n 1 };
        chomp( $VERSION );
      }

      # $module/$VERSION is just provisioning data, not really used anywhere
      print "$local $module $VERSION\n";
    }
    exit;
  }

  if ( $command eq "config" ) {
    my ($name, $value) = (shift,shift);

    my $output = config($name,$value);
    print "$output\n" if ($output);
    exit;
  }

  print "ERROR: I do now know what you want? See usage:\n";
  usage();

}

main(@ARGV);

__END__ # Documentation

=head1 NAME

git-perl ... - work easily with Perl CPAN modules repositories

=head1 USAGE

    git perl recent                                     = shows recent list of changes from https://metacpan.org/recent
    git perl log BAYASHI/Object-Container-0.16          = git clone repository and show latest changes
    git perl log BAYASHI/Object-Container-0.16 remove   = remove cloned repository
    git perl log Log::Any                               = git clone repository and show latest changes
    git perl log Log::Any remove                        = remove cloned repository
    git perl clone BAYASHI/Object-Container-0.16        = git clone repository
    git perl clone BAYASHI/Object-Container-0.16 remove = remove cloned repository
    git perl clone Log::Any                             = git clone repository
    git perl clone Log::Any remove                      = remove cloned repository
    git perl local                                      = list cloned repositories
    git perl local object-container-perl                = list cloned repository 'object-container-perl'
    git perl local object-container-perl log            = show latest changes in repository
    git perl local object-container-perl remove         = remove local repository stored in 'object-container-perl'
    git perl local Log::Any                             = git clone repository ( get remote repository locally )
    git perl local Log::Any remove                      = remove cloned repository

    git perl config                                     = show current config ( from ~/.config/git-perl.conf )
    git perl config dir                                 = show value of 'dir' from config
    git perl config dir ~/git/perl                      = set value of 'dir' to '~/git/perl'
    git perl config --unset dir                         = remove variable 'dir' from config file

=head1 SYNOPSIS

    $ git perl config dir ~/git/perl
    $ git perl recent
    ...
    02 Jul 2022 17:17:12 UTC GEEKRUTH/Dist-Zilla-PluginBundle-Author-GEEKRUTH-1.0202
    02 Jul 2022 17:26:20 UTC GENE/MIDI-Bassline-Walk-0.0402
    02 Jul 2022 17:27:54 UTC GEEKRUTH/Task-BeLike-GEEKRUTH-1.0200
    02 Jul 2022 18:00:59 UTC GEEKRUTH/DBIx-Class-Schema-ResultSetNames-1.0301
    02 Jul 2022 19:16:57 UTC DANX/Weather-NHC-TropicalCyclone-0.32
    02 Jul 2022 19:31:17 UTC TOBYINK/Mite-0.002003

    $ git perl log TOBYINK/Mite-0.002003
    commit 90c6ba708e995f7e06af559613c99ba252ee199a (HEAD -> master, origin/master, origin/HEAD)
    Author: Toby Inkster <mail@tobyinkster.co.uk>
    Date:   Sat Jul 2 20:40:44 2022 +0100

        Fix typos in the documentation for accessor

    diff --git a/lib/Mite/Manual/Syntax.pod b/lib/Mite/Manual/Syntax.pod
    index e6e5f91..54fe23b 100644
    ...

    $ git perl local
    p5-mite Mite 0.002003

    $ git perl local p5-mite remove
    Removed repository stored in subdir 'p5-mite'.

=head1 DESCRIPTION

It makes you easy to monitor recent changes in perl modules, and make you collaborate faster.

It is useful to monitor/read the latest code change in recently uploaded distribution. Good to read how authors solve the problems.

It will clone the remote repository locally, and you can easily collaborate on them, if/when needed.

=head1 INSTALLATION

Using C<cpan>

 $ cpan App::Git::Perl

Manual install:

 $ perl Makefile.PL
 $ make
 $ make install

=head1 AUTHOR

Nedzad Hrnjica <nedzad@nedzadhrnjica.com>

=head1 LICENSE

 Perl License (perl)

=cut

