Barcode.pm

package Barcode;
use strict;
#use Carp;
use Data::Dumper; $Data::Dumper::Sortkeys=1;

use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS
  %CONF %CONF_DEF $VERSION
);
@ISA = 'Exporter';
@EXPORT = qw( 
  %CONF YYYYMMDDHHMMSS 
  Dumper 
);
@EXPORT_OK   = qw( );
%EXPORT_TAGS = ();
$VERSION = '0.1';

sub Barcode::read_conf {
	my $config = shift;
	if (open C,'<',$config) {
		while (<C>) {
			chomp;
			next if (/^\s*#/);
			next if (/^\s*$/);
			my ($type,$keyval) = split(/\s+/,$_,2);
			$CONF{keyval}->{$type} = "$keyval / [$_]";
			my ($key,$val) = split(/\s+/,$keyval,2);
			if (defined($val)) {
				$CONF{$type}->{$key} = $val;
			}
		}
	}
	#print "XXX". Dumper(\%CONF);
# demacro the keys
	my $didreplace=1;
	while($didreplace) {
		$didreplace = 0;
		for my $type ( keys %CONF ) {
			next if ( $type eq 'macro' );
			for my $key ( keys %{$CONF{$type}} ) {
				for my $sub ( keys %{$CONF{macro}} ) {
					
#print "$type -> $key $sub\n";
					next if ( $sub eq $key );
					my $oldkey = $key;
					if ( $key =~ s/\$\{$sub?\}/$CONF{macro}->{$sub}/eg ) {
						$didreplace = 1;
						#print "CCCCCCC $key / $sub CCCCCC\n";
						$CONF{$type}->{$key} = $CONF{$type}->{$oldkey};
						delete $CONF{$type}->{$oldkey};
					}	
				}
			}
		}
	#print "XXX". Dumper(\%CONF);
	}
# now the values
	$didreplace=1;
	while($didreplace) {
		$didreplace = 0;
		for my $type ( keys %CONF ) {
			for my $key ( keys %{$CONF{$type}} ) {
				for my $sub ( keys %{$CONF{macro}} ) {
					
#print "$type -> $key -> $sub \n";
					next if ( $sub eq $key );
					if ( $CONF{$type}->{$key} =~ m{\$\{$key?\}} ) {
						warn "config loop key '$key' => $CONF{$type}->{$key} .\n";
						delete $CONF{$type}->{$key};
					}
					if ( $CONF{$type}->{$key} =~ s/\$\{$sub?\}/$CONF{macro}->{$sub}/eg ) {
						$didreplace = 1;
					}	
				}
			}
		}
	}
#	print "YYY". Dumper(\%CONF);
	for my $type ( keys %CONF_DEF ) {
		for my $key ( keys %{$CONF_DEF{$type}} ) {
			if ( !exists $CONF{$type}->{key} ) {
				$CONF{$type}->{$key} = $CONF_DEF{$type}->{$key};
			}
		}
	}
};


sub Barcode::read_conf_old {
	if (open C,'<',$CONF{config}) {
		while (<C>) {
			chomp;
			my ($key,$val) = split(/ /,$_,2);
			if (defined($val)) {
				if ( substr($key,0,1) eq '@' ) {
					push @{$CONF{$key}},$val;
				}
				else {
					$CONF{$key} = $val;
				}
			}
		}
	}
	my $didreplace=1;
	while($didreplace) {
		$didreplace = 0;
		for my $key ( keys %CONF ) {
			for my $sub ( keys %CONF ) {
				next if ( $sub eq $key );
				if ( $CONF{$key} =~ m{\$\{$key?\}} ) {
					warn "config loop key '$key' => $CONF{$key} .\n";
					delete $CONF{$key};
				}
				if ( $CONF{$key} =~ s/\$\{$sub?\}/$CONF{$sub}/eg ) {
					$didreplace = 1;
				}	
			}
		}
	}
	
}

sub YYYYMMDDHHMMSS {
  my $t=shift;
  !defined($t) and $t=time();
  my @T = localtime($t);$T[5]+=1900;$T[4]++;
  return sprintf "%04d-%02d-%02d %02d:%02d:%02d",$T[5],$T[4],$T[3],$T[2],$T[1],$T[0];
}

###################################################

BEGIN {
  # defaults
  %CONF_DEF = (
    'path' => {
		'dbfile' => '/project/barcode/db/scanner.sqlite3',
		'logfile' => '/project/barcode/log/barcodes.logger',
	}
  );
  Barcode::read_conf('/project/barcode/etc/barcode.conf');	

}

###################################################


1;