view release on metacpan or  search on metacpan

lib/Su/Log.pm  view on Meta::CPAN

Add the passed tag to the target tags list.

=cut

sub tag_on {
  shift if ( $_[0] eq __PACKAGE__ );
  my $tag = shift;
  push @target_tag, $tag;
}

=item tag_off()

Remove the passed tag from the target tags list.

=cut

sub tag_off {
  shift if ( $_[0] eq __PACKAGE__ );
  my $tag = shift;
  @target_tag = grep !/^$tag$/, @target_tag;
}

=item new()

Constructor.

 my $log = new Su::Log->new;
 my $log = new Su::Log->new($self);
 my $log = new Su::Log->new('PKG::TargetClass');

Instantiate the Logger class. The passed instance or the string of the
module name is registered as a logging target class. If the parameter
is omitted, then the caller is registered automatically.

=cut

sub new {
  my $self = shift;
  $self = ref $self if ( ref $self );
  my $target_class = shift;

  # If passed argment is a reference of the instance, then extract class name.
  my $class_name = ref $target_class;

  # Else, use passed string as class name.
  if ( !$class_name ) {
    $class_name = $target_class;
  }

  if ( !$class_name ) {
    $class_name = caller();
  }

  #  diag("classname:" . $class_name);
  #  diag( Dumper($class_name));
  # Su::Log->trace( "classname:" . $class_name );
  # Su::Log->trace( Dumper($class_name) );

  # Add the caller class to the target list automatically.

  return bless { class_name => $class_name, on => 1, level => $level }, $self;
} ## end sub new

=item is_target()

Determine whether the module is a logging target or not.

=cut

sub is_target {
  my $self = shift;

  if ($all_on) {

    return { is_target => 1, has_level => undef };
  } elsif ($all_off) {

    return { is_target => 0, has_level => undef };
  }

  my $self_class_name = $self;
  if ( ref $self ) {
    $self_class_name = $self->{class_name} ? $self->{class_name} : $class_name;
  }

  #diag("check classname:" . $self->{class_name});
  #  if(! defined($self->{class_name})){
  #    die "Class name not passed to the log instance.";
  #  }

#NOTE:Can not trace via trace or something Log class provide. Because recurssion occurs.
#diag( @target_class);

  # diag("grep result:" . (grep /^$self->{class_name}$/, @target_class));
  #  if (index($self->{class_name}, @target_class) != -1){
  # diag( "exc cls:" . Dumper(@exclusion_class) );
  if (
    grep {
      ref $_ eq 'Regexp'
        ? $self_class_name =~ /$_/
        : $self_class_name =~ /^$_$/
    } @exclusion_class
    )
  {
    return 0;
  } elsif (
    my @info =
    grep {
      my $bRegex = ref $_->{class} eq 'Regexp';
      if ($bRegex) {

        # diag('use regex');

        # Use class field as regexp.
        $self_class_name =~ /$_->{class}/;
      } else {

        # diag('use str');

        # Use class field as string,directly.
        $self_class_name =~ /^$_->{class}$/;