view release on metacpan or  search on metacpan

lib/Metabrik/Brik/Tool.pm  view on Meta::CPAN

   # Do your init here, return 0 on error.

   return \$self->SUPER::brik_init;
}

sub example_command {
   my \$self = shift;
   my (\$arg1, \$arg2) = \@_;

   \$arg2 ||= \$self->arg2;
   \$self->brik_help_run_undef_arg('example_command', \$arg1) or return;
   my \$ref = \$self->brik_help_run_invalid_arg('example_command', \$arg2, 'ARRAY', 'SCALAR')
      or return;

   if (\$ref eq 'ARRAY') {
      # Do your stuff
   }
   else {
      # Do other stuff
   }

   return 1;
}

sub brik_fini {
   my \$self = shift;

   # Do your fini here, return 0 on error.

   return \$self->SUPER::brik_fini;
}

1;

__END__

=head1 NAME

$package - $brik Brik

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2014-2022, Patrice E<lt>GomoRE<gt> Auffret

You may distribute this module under the terms of The BSD 3-Clause License.
See LICENSE file in the source distribution archive.

=head1 AUTHOR

Patrice E<lt>GomoRE<gt> Auffret

=cut
EOF
;

   $ft->write($data, $filename) or return;

   return $filename;
}

sub update_core {
   my $self = shift;

   my $datadir = $self->datadir;

   my $url = 'https://github.com/onyphe/metabrik-core';

   my $dg = Metabrik::Devel::Git->new_from_brik_init($self) or return;
   $dg->use_pager(0);
   my $pm = Metabrik::Perl::Module->new_from_brik_init($self) or return;
   $pm->use_pager(0);

   if (! -d $datadir.'/core') {
      $dg->clone($url, $datadir.'/core') or return;
   }
   else {
      $dg->update($datadir.'/core') or return;
   }

   $pm->build($datadir.'/core') or return;
   $pm->clean($datadir.'/core') or return;
   $pm->build($datadir.'/core') or return;
   $pm->test($datadir.'/core') or return;
   $pm->install($datadir.'/core') or return;

   return 1;
}

sub update_repository {
   my $self = shift;

   # If we define the core::global repository Attribute, we use that as 
   # a local repository. We will not install Metabrik::Repository in that case.
   my $datadir = $self->datadir;
   my $repository = $datadir.'/repository';

   my $url = 'https://github.com/onyphe/metabrik-repository';

   my $dg = Metabrik::Devel::Git->new_from_brik_init($self) or return;
   $dg->use_pager(0);
   my $pm = Metabrik::Perl::Module->new_from_brik_init($self) or return;
   $pm->use_pager(0);

   if (! -d $repository) {
      $dg->clone($url, $repository) or return;
   }
   else {
      $dg->update($repository) or return;
   }

   $pm->build($repository) or return;
   $pm->clean($repository) or return;
   $pm->build($repository) or return;
   $pm->test($repository) or return;
   $pm->install($repository) or return;

   $self->execute("cat $repository/UPDATING");

   $self->log->info("update_repository: the file just showed contains information that ".
                    "helps you follow API changes.");
   $self->log->info("Read it here [$repository/UPDATING].");

   return "$repository/UPDATING";
}

sub update {
   my $self = shift;

   $self->update_core or return;
   $self->update_repository or return;

   return 1;
}

sub test_repository {
   my $self = shift;
   my ($repository) = @_;

   $repository ||= $self->repository;
   $self->brik_help_run_undef_arg('test_repository', $repository) or return;

   my $pm = Metabrik::Perl::Module->new_from_brik_init($self) or return;
   $pm->use_pager(0);

   $pm->test($repository) or return;

   return 1;
}

sub view_brik_source {
   my $self = shift;
   my ($brik) = @_;

   $self->brik_help_run_undef_arg('view_brik_source', $brik) or return;

   my @toks = split(/::/, $brik);
   if (@toks < 2 && $brik ne 'metabrik') {
      return $self->log->error("view_brik_source: invalid Brik format for [$brik]");
   }

   # Handle special case for Metabrik.pm
   if ($brik eq 'metabrik') {
      @toks = ();
   }

   my $pager = $ENV{PAGER} || 'less';

   my $pm = 'Metabrik';
   for (@toks) {
      $_ = ucfirst($_);
      $pm .= "/$_";
   }
   $pm .= '.pm';

   $self->log->debug("view_brik_source: pm [$pm]");

   my $cmd = '';
   for (@INC) {
      $self->log->debug("view_brik_source: search [$_/$pm] file");
      if (-f "$_/$pm") {
         $cmd = "$pager $_/$pm";
         last;
      }
   }

   if (length($cmd) == 0) {