#!/usr/bin/env perl

our $VERSION = "0.1.2";

# 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 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 $urlpart = qx{ curl -s "https://metacpan.org/recent" | grep "$module" | head -n 1 | sed -e "s/.*a href=//" | cut -d\\" -f2 };
    chomp($urlpart);
    $url = "https://metacpan.org${urlpart}";
    logger("URL: [$url]");
  }

  logger("Getting repository details from '$url'...");
  my $repository = qx{ curl -s "$url" | grep ">Repository<" | sed -e "s/.* href=//" | cut -d\\" -f2 };
  chomp($repository);
  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" ) {
    #print qx{ curl -s "https://metacpan.org/recent" | grep "td" | grep class | grep name | tac | sed -e "s/.* title=//" | cut -d\\" -f2 };
    print qx{ curl -s "https://metacpan.org/recent"  | tr '\\n' ' ' | sed -e "s/<tr/\\n<tr/g" | grep "^<tr" | grep "title=" --color=never | sed -e 's/.*title="\\([^"]*\\)".* sort="\\([^"]*\\)".*/\\2 \\1/' | tac };
    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 - new git subcommad (git perl), that makes it easier to monitor recent changes in perl modules, and make you collaborate faster.

=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 AUTHOR

Nedzad Hrnjica
nedzad@nedzadhrnjica.com
https://nedzadhrnjica.com/

=head1 INSTALLATION

Using C<cpan>

 $ cpan App::Git::Perl

Manual install:

 $ perl Makefile.PL
 $ make
 $ make install

=head1 LICENSE

 Perl License (perl)

=head1 README

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

=cut

