view release on metacpan or  search on metacpan

lib/App/CSE.pm  view on Meta::CPAN

  unless( $ARGV[0] ){
    return 'help';
  }

  if( $ARGV[0] =~ /^-/ ){
    # The first argv is an option. Assume search
    return 'search';
  }

  ## Ok the first argv is a normal string.
  ## Attempt loading a command class.
  my $command_class = eval{ Class::Load::load_class(__PACKAGE__.'::Command::'.String::CamelCase::camelize($ARGV[0])) };
  if( $command_class ){
    # Valid command class. Return it.
    return shift @ARGV;
  };


  ## This first word is not a valid commnad class.
  ## Assume search.
  return 'search';

}

sub _build_command{
  my ($self) = @_;
  my $command_class = Class::Load::load_class(__PACKAGE__.'::Command::'.String::CamelCase::camelize($self->command_name()));
  my $command = $command_class->new({ cse => $self });
  return $command;
}

sub _build_options_specs{
  my ($self) = @_;
  return $self->command()->options_specs();
}

sub _build_options{
  my ($self) = @_;

  my %options = ();

  my $p = Getopt::Long::Parser->new;
  ## Avoid capturing unknown options, like -hello
  $p->configure( 'pass_through' );
  # Beware that accessing options_specs will consume the command as the first ARGV
  $p->getoptions(\%options , 'idx=s', 'dir=s', 'max-size=i', 'verbose+', @{$self->options_specs()} );
  return \%options;
}

sub _build_args{
  my ($self) = @_;
  $self->options();
  my @args = @ARGV;
  return \@args;
}

my $standard_log = q|
log4perl.rootLogger= INFO, Screen
log4perl.appender.Screen = Log::Log4perl::Appender::Screen
log4perl.appender.Screen.stderr = 0
log4perl.appender.Screen.layout = Log::Log4perl::Layout::PatternLayout
log4perl.appender.Screen.layout.ConversionPattern=%m%n
|;

my $verbose_log = q|
log4perl.rootLogger= TRACE, Screen
log4perl.appender.Screen = Log::Log4perl::Appender::Screen
log4perl.appender.Screen.stderr = 0
log4perl.appender.Screen.layout = Log::Log4perl::Layout::PatternLayout
log4perl.appender.Screen.layout.ConversionPattern = %d [%p] %m%n
|;


sub main{
  my ($self) = @_;

  unless( Log::Log4perl->initialized() ){

    binmode STDOUT , ':utf8';
    binmode STDERR , ':utf8';

    if( $self->options()->{verbose} ){
      Log::Log4perl::init(\$verbose_log);
    }else{
      Log::Log4perl::init(\$standard_log);
    }
  }

  return $self->command()->execute();
}

sub save_index_meta{
  my ($self) = @_;
  File::Slurp::write_file($self->index_meta_file().'' , { binmode => ':raw' }, JSON::encode_json($self->index_meta));
  return 1;
}

sub save_dirty_files{
  my ($self) = @_;
  File::Slurp::write_file($self->index_dirty_file().'' , { binmode => ':raw' }, JSON::encode_json($self->dirty_files));
  return 1;
}

sub version{
  my ($self) = @_;
  return $App::CSE::VERSION || 'dev';
}


# Performs very basic checks on a filename, see if its valid
# for indexing.
sub is_file_valid{
  my ($self, $file_name , $opts ) = @_;

  unless( defined( $opts ) ){
    $opts = {};
  }

  if( $self->ignore_reassembl()->match( $file_name ) ){
      $LOGGER->trace("File $file_name is ignoreed. Skipping");
      return $opts->{on_skip} ? &{$opts->{on_skip}}() : undef;
  }

  if( $file_name =~ /(?:\/|^)\.[^\/\.]+/ ){
    $LOGGER->trace("File $file_name is hidden. Skipping");
    return $opts->{on_hidden} ? &{$opts->{on_hidden}}() : undef;
  }