--- trunk/lib/WebPAC/Common.pm	2005/07/24 15:07:56	32
+++ trunk/lib/WebPAC/Common.pm	2007/11/01 00:16:46	948
@@ -1,13 +1,20 @@
 package WebPAC::Common;
+use Exporter 'import';
+@EXPORT = qw/
+	force_array
+/;
 
 use warnings;
 use strict;
 
 use Log::Log4perl qw/get_logger :levels/;
 use Time::HiRes qw/time/;
+use Data::Dump qw/dump/;
+use File::Spec;
+use Cwd qw/abs_path/;
 
-# If ture, enable logging debug
-my $log_debug = 0;
+use base qw/Class::Accessor/;
+__PACKAGE__->mk_accessors( qw/log_debug no_log debug/ );
 
 =head1 NAME
 
@@ -15,17 +22,42 @@
 
 =head1 VERSION
 
-Version 0.01
+Version 0.05
 
 =cut
 
-our $VERSION = '0.01';
+our $VERSION = '0.05';
 
 =head1 SYNOPSYS
 
 This module defines common functions, and is used as base for other, more
 specific modules.
 
+my $o = WebPAC::Common->new({
+	log_debug => 1,
+	no_log => 1,
+	debug => 1,
+});
+
+Options:
+
+=over 20
+
+=item log_debug
+
+Generate additional debugging log on C<STDERR>
+
+=item no_log
+
+Disable all logging (useful for tests)
+
+=item debug
+
+Use debugging logger which dumps output only yo C<STDERR>
+
+=back
+
+
 =head1 FUNCTIONS
 
 =head2 progress_bar
@@ -43,6 +75,8 @@
 
 	my $log = $self->_get_logger();
 
+	$self->{last_pcnt_t} ||= time();
+
 	$log->logconfess("no current value!") if (! $curr);
 	$log->logconfess("no maximum value!") if (! $max);
 
@@ -62,14 +96,16 @@
 		$self->{'start_t'} = time();
 	}
 
-	if ($p != $self->{'last_pcnt'}) {
+	my $t = time();
+
+	if ($p != $self->{'last_pcnt'} || ( $t - $self->{last_pcnt_t} ) > 2 ) {
 
-		my $t = time();
 		my $rate = ($curr / ($t - $self->{'start_t'} || 1));
 		my $eta = ($max-$curr) / ($rate || 1);
 		printf STDERR ("%5d [%-38s] %-5d %0.1f/s %s\r",$curr,"=" x ($p/3)."$p%>", $max, $rate, $self->fmt_time($eta));
 		$self->{'last_pcnt'} = $p;
 		$self->{'last_curr'} = $curr;
+		$self->{last_pcnt_t} = $t;
 	}
 	print STDERR "\n" if ($p == 100);
 }
@@ -97,10 +133,79 @@
 	return $out;
 }
 
+=head2 fill_in
+
+Fill in variable names by values
+
+  print $webpac->fill_in( 'foo = $foo bar = $bar',
+  	foo => 42, bar => 11,
+  );
+
+=cut
+
+sub fill_in {
+	my $self = shift;
+
+	my $format = shift || die "no format?";
+	my $d = {@_};
+
+	foreach my $n ( keys %$d ) {
+		$format =~ s/\$\Q$n\E/$d->{$n}/gs;
+	}
+
+	die "unknown variables in '$format' input data = ", dump( $d ) if ( $format =~ m/\$\w+/ );
+
+	return $format;
+}
+
 #
 #
 #
 
+=head2 var_path
+
+  my $path = $self->var_path('data_dir', 'data_file', ... );
+
+=cut
+
+my $abs_path;
+
+sub var_path {
+	my $self = shift;
+
+	if ( ! $abs_path ) {
+#		$abs_path = abs_path( $0 );
+#		$abs_path =~ s!/WebPAC/Common\.pm!!;
+		$abs_path = '/data/webpac2';
+	}
+
+	return File::Spec->catfile($abs_path, 'var', @_);
+}
+
+=head1 EXPORTED NETHODS
+
+=head2 force_array
+
+  my @array = force_array( $ref, sub {
+  	warn "reference is undefined!";
+  });
+
+=cut
+
+sub force_array {
+	my ( $what, $error ) = @_;
+	my @result;
+	if ( ref( $what ) eq 'ARRAY' ) {
+		@result = @{ $what };
+	} elsif ( defined $what ) {
+		@result =  ( $what );
+	} else {
+		$error->() if ref($error) eq 'CODE';
+	}
+	return @result;
+}
+
+
 =head1 INTERNAL METHODS
 
 Here is a quick list of internal methods, mostly useful to turn debugging
@@ -160,9 +265,10 @@
 	my $name = (caller(2))[3] || caller;
 
 	my $conf = q( );
-	if ($self->{'no_log'}) {
-		warn "# $name disabled logging\n" if ($log_debug);
-	} elsif ($self->{'debug'}) {
+	if ($self->no_log) {
+		warn "# $name disabled logging\n" if $self->log_debug;
+		$Log::Log4perl::Config::CONFIG_INTEGRITY_CHECK = 0;
+	} elsif ($self->debug) {
 		$conf = << '_log4perl_';
 
 log4perl.rootLogger=INFO, SCREEN
@@ -174,14 +280,15 @@
 log4perl.appender.SCREEN.layout.ConversionPattern=%d %p> %F{1}:%L %M - %m%n
 
 _log4perl_
-		warn "# $name is using debug logger\n" if ($log_debug);
-	} elsif ($name !~ m/Test::Exception/o) {
-		warn "# disabled logging for Text::Exception\n" if ($log_debug);
-	} elsif ($file) {
-		warn "# $name is using $file logger\n" if ($log_debug);
+		warn "# $name is using debug logger\n" if $self->log_debug;
+	} elsif ($name =~ m/Test::Exception/o) {
+		warn "# disabled logging for Text::Exception\n" if $self->log_debug;
+	} elsif (-e $file) {
+		warn "# $name is using $file logger\n" if $self->log_debug;
 		Log::Log4perl->init($file);
+		return 1;
 	} else {
-		warn "# $name is using null logger\n" if ($log_debug);
+		warn "# $name is using null logger\n" if $self->log_debug;
 	}
 	Log::Log4perl->init( \$conf );
 
@@ -198,18 +305,48 @@
 
 =cut
 
+my $_logger_seen;
+
 sub _get_logger {
 	my $self = shift;
 
-	my $name = (caller(2))[3] || caller;
-	$self->{'_logger_'} ||= $self->_init_logger;
+	my $name = (caller(1))[3] || caller;
+
+	# make name full
+	my $f = '';
+	if ( $self->log_debug ) {
+		foreach ( 0 .. 5 ) {
+			my $s = (caller($_))[3];
+			$f .= "#### $_ >> $s\n" if ($s);
+		}
+	}
 
-	warn "# get_logger( $name )\n" if ($log_debug);
+	$self->{'_logger_'} ||= $self->_init_logger;
 
-	return get_logger($name);
+	my $log = get_logger( $name );
+	warn "# get_logger( $name ) level ", $log->level, "\n$f" if ($self->log_debug && !defined($_logger_seen->{$name}));
+	$_logger_seen->{$name}++;
+	return $log;
 }
 
 
+=head2 _log
+
+Quick cludge to make logging object available to scripts which
+use webpac line this:
+
+  my $log = _new WebPAC::Common()->_get_logger();
+
+=cut
+
+sub _new {
+	my $class = shift;
+	my $self = {@_};
+	bless($self, $class);
+
+	$self ? return $self : return undef;
+}
+
 =head1 LOGGING
 
 Logging in WebPAC is performed by L<Log::Log4perl> with config file
@@ -224,4 +361,6 @@
 also use method names, and not only classes (which are just few)
 to filter logging.
 
+=cut
 
+1;