package DBR::Common; use strict; use Time::HiRes; use Carp; my %TIMERS; sub _uniq{ my $self = shift; my $has_undef; my %uniq; return grep{ defined($_)?( !$uniq{$_}++ ):( !$has_undef++ ) } @_; } sub _split{ my $self = shift; my $value = shift; my $out; if(ref($value)){ $out = $value; }else{ $value =~ s/^\s*|\s*$//g; $out = [ split(/\s+/,$value) ]; } return wantarray? (@$out): $out; } sub _arrayify{ my $self = shift; my @out = map { ref($_) eq 'ARRAY' ? (@$_) : ($_) } @_; return wantarray? (@out) : \@out; } sub _hashify{ my $self = shift; my %out; while(@_){ my $k = shift; if(ref($k) eq 'HASH'){ %out = (%out,%$k); next; } my $v = shift; $out{ $k } = $v; } return wantarray? (%out) : \%out; } # returns true if all elements of Arrayref A (or single value) are present in arrayref B sub _b_in{ my $self = shift; my $value1 = shift; my $value2 = shift; $value1 = [$value1] unless ref($value1); $value2 = [$value2] unless ref($value2); return undef unless (ref($value1) eq 'ARRAY' && ref($value2) eq 'ARRAY'); my %valsA = map {$_ => 1} @{$value2}; my $results; foreach my $val (@{$value1}) { unless ($valsA{$val}) { return 0; } } return 1; } sub _stopwatch{ my $self = shift; my $label = shift; my ( $package, $filename, $line, $method ) = caller( 1 ); # First caller up $method ||= ''; my ($m) = $method =~ /([^\:]*)$/; if($label){ my $elapsed = Time::HiRes::time() - $TIMERS{$method}; my $seconds = sprintf('%.8f',$elapsed); $self->_logDebug2( "$m ($label) took $seconds seconds"); } $TIMERS{ $method } = Time::HiRes::time(); # Logger could be slow return 1; } sub _log { my $s = shift->_session or return 1; $s->_log( shift, 'INFO' ); return 1 } sub _logDebug { my $s = shift->_session or return 1; $s->_log( shift, 'DEBUG' ); return 1 } sub _logDebug2 { my $s = shift->_session or return 1; $s->_log( shift, 'DEBUG2' ); return 1 } sub _logDebug3 { my $s = shift->_session or return 1; $s->_log( shift, 'DEBUG3' ); return 1 } sub _warn { my $s = shift->_session or return 1; $s->_log( shift, 'WARN' ); return 1 } sub _error { my $s = shift->_session; if(!$s || $s->use_exceptions){ local $Carp::CarpLevel = 1; croak shift; } if($s){ $s->_log( shift, 'ERROR' ) }else{ print STDERR "DBR ERROR: " . shift() . "\n"; } return undef; } sub _session { $_[0]->{session} } sub is_debug { $_[0]->{debug} } package DBR::Common::DummySession; # sub _error { # my $self = shift; # my $message = shift; # my ( $package, $filename, $line, $method) = caller(1); # if ($self->session){ # $self->session->logErr($message,$method); # }else{ # print STDERR "DBR ERROR: $message ($method, line $line)\n"; # } # return undef; # } # sub _logDebug{ # my $self = shift; # my $message = shift; # my ( $package, $filename, $line, $method) = caller(1); # if ($self->session){ # $self->session->logDebug($message,$method); # }elsif($self->is_debug){ # print STDERR "DBR DEBUG: $message\n"; # } # } # sub _logDebug2{ # my $self = shift; # my $message = shift; # my ( $package, $filename, $line, $method) = caller(1); # if ($self->session){ # $self->session->logDebug2($message,$method); # }elsif($self->is_debug){ # print STDERR "DBR DEBUG2: $message\n"; # } # } # sub _logDebug3{ # my $self = shift; # my $message = shift; # my ( $package, $filename, $line, $method) = caller(1); # if ($self->session){ # $self->session->logDebug3($message,$method); # }elsif($self->is_debug){ # print STDERR "DBR DEBUG3: $message\n"; # } # } # #HERE HERE HERE - do some fancy stuff with dummy subroutines in the symbol table if nobody is in debug mode # sub _log{ # my $self = shift; # my $message = shift; # my ( $package, $filename, $line, $method) = caller(1); # if ($self->session){ # $self->session->log($message,$method,'INFO'); # }else{ # print STDERR "DBR: $message\n"; # } # return 1; # } 1;