Class-Config-0.01/0040755000076400007640000000000010047111226012032 5ustar dondonClass-Config-0.01/Makefile.PL0100755000076400007640000000212010007103741013776 0ustar dondon#!/usr/bin/perl # Creation date: 2004-01-31 20:13:44 # Authors: Don # Change log: # $Id: Makefile.PL,v 1.1 2004/02/01 05:00:17 don Exp $ use strict; use Carp; # main { local($SIG{__DIE__}) = sub { &Carp::cluck(); exit 0 }; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Class::Config', DISTNAME => 'Class-Config', VERSION_FROM => 'Config.pm', ABSTRACT => 'Methods From Config Files', AUTHOR => 'DON OWENS ', PM => { 'Config.pm' => '$(INST_LIBDIR)/Config.pm', 'Config/File.pm' => '$(INST_LIBDIR)/Config/File.pm', }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz' }, DIR => [], EXE_FILES => [], PREREQ_PM => { Carp => 0, # 'Tie::Hash' => 0, }, ); } exit 0; ############################################################################### # Subroutines Class-Config-0.01/Config/0040755000076400007640000000000010047111226013237 5ustar dondonClass-Config-0.01/Config/File.pm0100644000076400007640000001072410037274423014465 0ustar dondon# -*-perl-*- # Creation date: 2003-10-30 23:04:19 # Authors: Don # Change log: # $Id: File.pm,v 1.4 2004/02/01 09:43:42 don Exp $ use strict; { package Class::Config::File; use vars qw($VERSION); $VERSION = do { my @r=(q$Revision: 1.4 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r }; sub new { my ($proto, $file_path, $params) = @_; my $self = bless {}, ref($proto) || $proto; $self->setFilePath($file_path); $params = {} unless ref($params) eq 'HASH'; $self->setParams($params); return $self; } sub slurpFile { my ($self, $file_path) = @_; local(*IN); open(IN, '<' . $file_path) or return undef; my $contents = ''; my $buf = ''; $contents .= $buf while read(IN, $buf, 1024); close IN; return $contents; } sub load { my ($self) = @_; my $file = $self->getFilePath; my $params = $self->getParams; my $name_space = $$params{name_space}; local($SIG{__DIE__}); # my $file_content = $self->slurpFile($file); $name_space = 'Class::Config::File::Temp' if $name_space eq ''; my $to_eval = qq{package $name_space; use vars qw(\$info);\n}; $to_eval .= qq{do "$file"; die "do failed on $file: \$\@" if \$\@;}; eval $to_eval; if ($@) { # FIXME: need to figure out what to do here # print "do failed: $@\n"; return undef; } my $info_var = "${name_space}::info"; no strict 'refs'; my $info = ${"$info_var"}; $self->setConfigHash($info); } sub exportMethodsToPackage { my ($self, $package, $filters) = @_; if (defined($filters) and ref($filters) ne 'ARRAY') { $filters = [ $filters ]; } $package = ref($package) if ref($package); my $info = $self->getConfigHash; no strict 'refs'; while (my ($field, $value) = each %$info) { my $meth_name = $self->convertFieldToMethodName($field); # create an anonymous subroutine to do the work, then give it a name my $meth; if ($filters) { # apply filters $meth = sub { my $val = $value; foreach my $filter (@$filters) { if (ref($filter) eq 'ARRAY') { my ($obj, $func, @args) = @$filter; if (ref($obj) eq 'CODE') { # subroutine reference my @new_args = @$filter; shift @new_args; $val = $obj->($val, @new_args); } else { $val = $obj->$func($val, @args); } } else { $val = $filter->($val); } } return $val; } } else { $meth = sub { return $value }; } *{"$package\:\:$meth_name"} = $meth; } return 1; } sub convertFieldToMethodName { my ($self, $field) = @_; my $meth_name = ucfirst($field); $meth_name =~ s/_(.)/\U$1/g; $meth_name = 'get' . $meth_name; return $meth_name; } sub interpolate { my ($self, $value) = @_; return $value; } ##################### # getters and setters sub getParams { my ($self) = @_; return $$self{_params}; } sub setParams { my ($self, $params) = @_; $$self{_params} = $params; } sub getConfigHash { my ($self) = @_; return $$self{_config_hash}; } sub setConfigHash { my ($self, $config) = @_; $$self{_config_hash} = $config; } sub getFilePath { my ($self) = @_; return $$self{_file}; } sub setFilePath { my ($self, $file) = @_; $$self{_file} = $file; } } 1; __END__ =pod =head1 NAME Class::Config::File - Container for a configuration file. =head1 SYNOPSIS This module is not meant to be used directly. Please use Class::Config instead. =head1 DESCRIPTION =head1 METHODS =head1 EXAMPLES =head1 BUGS =head1 AUTHOR =head1 VERSION $Id: File.pm,v 1.4 2004/02/01 09:43:42 don Exp $ =cut Class-Config-0.01/META.yml0100644000076400007640000000051710047111226013303 0ustar dondon# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Class-Config version: 0.01 version_from: Config.pm installdirs: site requires: Carp: 0 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.17 Class-Config-0.01/t/0040755000076400007640000000000010047111226012275 5ustar dondonClass-Config-0.01/t/01conf.t0100755000076400007640000000602010007145116013547 0ustar dondon#!/usr/bin/env perl -w # Creation date: 2004-01-31 21:13:11 # Authors: Don # Change log: # $Id: 01conf.t,v 1.1 2004/02/01 09:43:42 don Exp $ use strict; # main { use Test; BEGIN { plan tests => 5 } use lib '/owens_lib'; use Class::Config; my $conf = Class::Config->new; # create temporary conf files and load them my $file1 = &get_unique_file_path(); my $file2 = &get_unique_file_path(); my $str1 = q{field1 => 'val1', field2 => 'val2', field3 => 'val3'}; my $str2 = q{field2 => 'val2_2', field4 => 'val4', }; $str2 .= q{field4_int => '[[say_hello]]', sub_check => 'sub_ref', }; $str2 .= q{single_sub => 'single_sub_val'}; &setup_file($file1, $str1); &setup_file($file2, $str2); my @files = ($file1, $file2); my $obj = $conf->load(\@files, undef, [ [ __PACKAGE__, 'interpolate_meth' ], [ \&sub_ref, 'is_subref' ], \&single_sub, ]); my $field1 = $obj->getField1; my $field2 = $obj->getField2; my $field3 = $obj->getField3; my $field4 = $obj->getField4; my $field4_int = $obj->getField4Int; my $sub_check = $obj->getSubCheck; my $single_sub = $obj->getSingleSub; # print "Got field1='$field1', field2='$field2', field3='$field3', field4='$field4'\n"; # print "field4_int='$field4_int'\n"; # print "sub_check='$sub_check'\n"; # print "single_sub='$single_sub'\n"; # can get values ok($field1 eq 'val1' and $field3 eq 'val3'); # override inherited val ok($field2 eq 'val2_2' and $field4 eq 'val4'); # filters # simple ok($field4_int eq 'interpolated_say_hello'); # code reference with args ok($sub_check eq 'sub_ref_got_it_is_subref'); # simple code reference ok($single_sub eq 'single_sub_val_got_single_sub'); unlink $file1; unlink $file2; } exit 0; ############################################################################### # Subroutines sub single_sub { my ($val) = @_; if ($val eq 'single_sub_val') { $val .= '_got_single_sub'; } return $val; } sub sub_ref { my ($val, $arg1) = @_; if ($val eq 'sub_ref') { $val .= "_got_it_$arg1"; } return $val; } sub say_hello { return "say_hello"; } sub interpolate_meth { my ($self, $value) = @_; if (ref($value) eq '') { $value =~ s/\[\[(\S+)\]\]/'interpolated_' . $self->$1()/eg; } return $value; } sub setup_file { my ($file, $str) = @_; local(*OUT); open(OUT, ">$file"); print OUT '$info = {', "\n"; print OUT $str, "\n};\n"; print OUT "1;\n"; close OUT; } sub get_unique_file_path { my $dir = '/tmp'; my $name = '___' . $$ . '_' . time() . int(1000 + rand(9000)) . '.pm'; my $path = "$dir/$name"; while (-e $path) { sleep 1; $name = '___' . $$ . '_' . time() . int(1000 + rand(9000)) . '.pm'; $path = "$dir/$name"; } return $path; } Class-Config-0.01/t/00use.t0100755000076400007640000000053710007103741013422 0ustar dondon#!/usr/bin/env perl -w # Creation date: 2004-01-31 20:39:15 # Authors: Don # Change log: # $Id: 00use.t,v 1.1 2004/02/01 05:00:17 don Exp $ use strict; # main { use Test; BEGIN { plan tests => 1 } use Class::Config; ok(1); } exit 0; ############################################################################### # Subroutines Class-Config-0.01/README0100644000076400007640000001030010007145233012702 0ustar dondonNAME Class::Config - Methods From Config Files SYNOPSIS use Class::Config; my $conf = Class::Config->new; my $obj = $conf->load(\@files, $inherit_from, $filters); DESCRIPTION This module generates unique namespaces for new classes that contain methods created from the key/value pairs from hashes in configuration files. This is useful for reusing code, such as modules and scripts for an entire website, but changing certain parameters based on an environment variable, for instance. Method names are generated by capitalizing the first letter and the first letter after each underscore, then adding 'get' in front. For example, if one of the files in @files contains the following: $info = { field1 => 'value1', field2 => [ 'element1', 'element2' ], longer_field_name => 'longer value', }; the methods getField1(), getField2(), and getLongerFieldName() will be available via the object returned by Class::Config. The files are loaded and the methods are set up in an inheritance hierarchy in the same order they are passed to the load() method - the entries in the 2nd file are placed into a class that inherits from the class generated by the entries in the first file, the entries in the third file inherit from those in the 2nd file, and so on. The $inherit_from parameter passed to the load() method indicates what class, if any, the class generated by the 1st file should inhert from. The $filters parameter is an optional set of filters to be run on each value before being returned. See the documentation on the load() method below for details. The configuration files should not contain a package name. The contents of each file is eval'd in the scope of a unique package. The package global $info must be set to the hash reference that you wish to be used for setting up the methods. Since the configuration files are eval'd, you may write your own subroutines in the configuration files to make them available as methods in the package generated. However, they will be overridden by and methods generated with the same name from the entries in the $info hash. This module has been tested on unix only. It currently depends on device and inode numbers to generate unique namespaces, so it may not work on non-unix platforms. METHODS new() Creates a Class::Config object. load($file, $inherit_from, $filters) Loads the file given by $file and generates a unique package for the file, converting entries in the hash reference $info into methods. If $file is a reference to an array, each file name in the array will be loaded in sequence, each on inheriting from the file processed before it. The $inherit_from parameter, if specified, will be used to set up the inheritance for the first file specified. The $filters parameter is an optional array of filters to be run on each value before being returned. Each element of the array can be specified in one of three ways. For example, my $filters = [ [ $obj, $method_name, @args ], [ \&sub_ref, @args], [ \&sub_ref ] ]; The first filter will result in the method $method_name being called on the object $obj and passed the value from the configuration file, and then the arguments in @args, i.e., my $cur_val = $obj->$method_name($val, @args); The second filter will result in the subroutine sub_ref() being called with the value as its first argument, and @args as the rest of the arguments, i.e., my $cur_val = $sub_ref->($val, @args); The third filter will result in the subroutine sub_ref() being called with just the value as its argument, i.e., my $cur_val = $sub_ref->(); AUTHOR Don Owens COPYRIGHT Copyright (c) 2003 Don Owens All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. VERSION 0.01 Class-Config-0.01/Config.pm0100644000076400007640000001661610037274423013614 0ustar dondon# -*-perl-*- # Creation date: 2003-10-30 23:03:11 # Authors: Don # Change log: # $Id: Config.pm,v 1.7 2004/02/01 09:44:52 don Exp $ =pod =head1 NAME Class::Config - Methods From Config Files =head1 SYNOPSIS use Class::Config; my $conf = Class::Config->new; my $obj = $conf->load(\@files, $inherit_from, $filters); =head1 DESCRIPTION This module generates unique namespaces for new classes that contain methods created from the key/value pairs from hashes in configuration files. This is useful for reusing code, such as modules and scripts for an entire website, but changing certain parameters based on an environment variable, for instance. Method names are generated by capitalizing the first letter and the first letter after each underscore, then adding 'get' in front. For example, if one of the files in @files contains the following: $info = { field1 => 'value1', field2 => [ 'element1', 'element2' ], longer_field_name => 'longer value', }; the methods getField1(), getField2(), and getLongerFieldName() will be available via the object returned by Class::Config. The files are loaded and the methods are set up in an inheritance hierarchy in the same order they are passed to the load() method - the entries in the 2nd file are placed into a class that inherits from the class generated by the entries in the first file, the entries in the third file inherit from those in the 2nd file, and so on. The $inherit_from parameter passed to the load() method indicates what class, if any, the class generated by the 1st file should inhert from. The $filters parameter is an optional set of filters to be run on each value before being returned. See the documentation on the load() method below for details. The configuration files should not contain a package name. The contents of each file is eval'd in the scope of a unique package. The package global $info must be set to the hash reference that you wish to be used for setting up the methods. Since the configuration files are eval'd, you may write your own subroutines in the configuration files to make them available as methods in the package generated. However, they will be overridden by and methods generated with the same name from the entries in the $info hash. This module has been tested on unix only. It currently depends on device and inode numbers to generate unique namespaces, so it may not work on non-unix platforms. =head1 METHODS =cut use strict; { package Class::Config; use vars qw($VERSION); BEGIN { $VERSION = '0.01'; # also change below in POD! } use Class::Config::File; =pod =head2 new() Creates a Class::Config object. =cut sub new { my ($proto) = @_; my $self = bless {}, ref($proto) || $proto; return $self; } sub _getSubNameSpace { my ($self, $file) = @_; my @stat_info = CORE::stat($file); my ($dev, $ino) = @stat_info[0,1]; return join('_', map { sprintf("%x", $_) } ($dev, $ino)); } sub loadFile { my ($self, $file) = @_; my $name = $self->_getSubNameSpace($file); my $name_space = "Class::Config::Confs::$name"; my $obj = Class::Config::File->new($file, { name_space => $name_space, path => $file }); $obj->load; return $obj; } =pod =head2 load($file, $inherit_from, $filters) Loads the file given by $file and generates a unique package for the file, converting entries in the hash reference $info into methods. If $file is a reference to an array, each file name in the array will be loaded in sequence, each on inheriting from the file processed before it. The $inherit_from parameter, if specified, will be used to set up the inheritance for the first file specified. The $filters parameter is an optional array of filters to be run on each value before being returned. Each element of the array can be specified in one of three ways. For example, my $filters = [ [ $obj, $method_name, @args ], [ \&sub_ref, @args], [ \&sub_ref ] ]; The first filter will result in the method $method_name being called on the object $obj and passed the value from the configuration file, and then the arguments in @args, i.e., my $cur_val = $obj->$method_name($val, @args); The second filter will result in the subroutine sub_ref() being called with the value as its first argument, and @args as the rest of the arguments, i.e., my $cur_val = $sub_ref->($val, @args); The third filter will result in the subroutine sub_ref() being called with just the value as its argument, i.e., my $cur_val = $sub_ref->(); =cut sub load { my ($self, $file, $inherit_from, $filters) = @_; my $file_list; if (ref($file) eq 'ARRAY') { $file_list = $file; } else { $file_list = [ $file ]; } return $self->_loadMultiple($file_list, $inherit_from, $filters); } sub _loadMultiple { my ($self, $file_list, $inherit_from, $filters) = @_; my $obj_list = []; foreach my $file (@$file_list) { my $obj = $self->loadFile($file); push @$obj_list, $obj; } return $self->setupMethodsAndInheritance($obj_list, $inherit_from, $filters); } sub setupMethodsAndInheritance { my ($self, $file_obj_list, $inherit_from, $filters) = @_; my $first = 1; my $cur_name = ''; foreach my $file_obj (@$file_obj_list) { my $params = $file_obj->getParams; my $file = $$params{path}; my $name = $self->_getSubNameSpace($file); if ($first) { $name = "Class::Config::Confs::$name"; } else { $name = $cur_name . '_' . $name; } my $file_path = $file_obj->getFilePath; my $obj = Class::Config::File->new($file_path, { name_space => $name, path => $file }); $obj->load; $obj->exportMethodsToPackage($name, $filters); if ($first) { if ($inherit_from) { my $pkg = ref($inherit_from) || $inherit_from; eval qq{\@${name}::ISA = '$pkg'}; } } else { eval qq{\@${name}::ISA = '$cur_name'}; } $cur_name = $name; $first = undef; } return bless {}, $cur_name; } sub setupInheritance { my ($self, $parent_obj_or_pkg, $child_obj_or_pkg) = @_; my $child_pkg = ref($child_obj_or_pkg) ? ref($child_obj_or_pkg) : $child_obj_or_pkg; my $parent_pkg = ref($parent_obj_or_pkg) ? ref($parent_obj_or_pkg) : $parent_obj_or_pkg; no strict 'refs'; my $isa = \@{"${child_pkg}::ISA"}; unless (scalar(@$isa) and $$isa[$#{$isa}] eq $parent_pkg) { push @$isa, $parent_pkg; } return 1; } sub interpolate { my ($self, $value) = @_; if (ref($value) eq '') { $value =~ s/\[\[(\S+)\]\]/$self->$1()/eg; } return $value; } } 1; __END__ =pod =head1 AUTHOR Don Owens =head1 COPYRIGHT Copyright (c) 2003 Don Owens All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 VERSION 0.01 =cut Class-Config-0.01/MANIFEST0100644000076400007640000000023110007145320013152 0ustar dondonMANIFEST Makefile.PL README Config.pm Config/File.pm t/00use.t t/01conf.t META.yml Module meta-data (added by MakeMaker)