Author: dylan
Date: 2005-06-21 02:40:14 -0400 (Tue, 21 Jun 2005)
New Revision: 786
Modified:
trunk/
trunk/perl/core/Build.PL
trunk/perl/core/lib/Haver/Base.pm
trunk/perl/core/lib/Haver/Config.pm
trunk/perl/core/lib/Haver/Wheel.pm
trunk/perl/core/t/001_config.t
trunk/perl/core/t/003_wheel.t
Log:
[EMAIL PROTECTED]: dylan | 2005-06-21 01:47:11 -0400
improving test coverage, changed recommends => to suggests, etc.
Property changes on: trunk
___________________________________________________________________
Name: svk:merge
- 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43050
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1123
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
+ 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43050
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1126
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
Modified: trunk/perl/core/Build.PL
===================================================================
--- trunk/perl/core/Build.PL 2005-06-21 02:49:41 UTC (rev 785)
+++ trunk/perl/core/Build.PL 2005-06-21 06:40:14 UTC (rev 786)
@@ -10,7 +10,7 @@
YAML => '0.35',
'Filter::Simple' => 0,
},
- recommends => {
+ suggests => {
'Haver::Server' => 0.06,
'Haver::Client' => 0.06,
'POE' => 0.28,
Modified: trunk/perl/core/lib/Haver/Base.pm
===================================================================
--- trunk/perl/core/lib/Haver/Base.pm 2005-06-21 02:49:41 UTC (rev 785)
+++ trunk/perl/core/lib/Haver/Base.pm 2005-06-21 06:40:14 UTC (rev 786)
@@ -5,6 +5,7 @@
use Carp;
use constant DEBUG => 1;
+our $VERSION = 0.08;
our @EXPORT_BASE = qw( DEBUG field croak carp confess );
field 'factory';
Modified: trunk/perl/core/lib/Haver/Config.pm
===================================================================
--- trunk/perl/core/lib/Haver/Config.pm 2005-06-21 02:49:41 UTC (rev 785)
+++ trunk/perl/core/lib/Haver/Config.pm 2005-06-21 06:40:14 UTC (rev 786)
@@ -10,38 +10,59 @@
our $VERSION = 0.10;
field 'file';
-field 'config' => {};
-field 'default' => {};
+field config => {};
-sub initialize {
+sub load {
+ my ($self, $file) = @_;
+ $self->file($file);
+ my $config = -e $file ? YAML::LoadFile($file) : {};
+ $self->config($config);
+
+ return 1;
+}
+
+sub reload {
my $self = shift;
- my $file = $self->{file};
+ my $file = $self->file;
my $config = -e $file ? YAML::LoadFile($file) : {};
- $self->{config} = merge_hash($config, $self->{default} || {});
+ $self->config($config);
+
+ return 1;
}
+sub merge {
+ my ($self, $hash) = @_;
+ $self->config(_merge_hash($self->config, $hash));
-sub load() {
- my ($this, $file, $def) = @_;
- my $self = $this->new(
- file => $file,
- default => $def,
- );
-
- return $self;
+ return 1;
}
sub save {
my $self = shift;
- YAML::DumpFile($self->{file}, $self->{config});
+ YAML::DumpFile($self->file, $self->config);
}
+sub get {
+ my ($self, $key) = @_;
+ return $self->{config}{$key};
+}
+
+sub set {
+ my ($self, $key, $val) = @_;
+ return $self->{config}{$key} = $val;
+}
+
+sub del {
+ my ($self, $key) = @_;
+ delete $self->{config}{$key};
+}
+
# Author: bdonlan
-sub merge_struct ($$) {
+sub _merge_struct ($$) {
# ASSERT: @_ == 2;
my ($left, $right) = @_;
- my $func = "merge_struct(\$left,\$right):";
+ my $func = "_merge_struct(\$left,\$right):";
unless (ref $left and ref $right) {
return $left;
@@ -51,23 +72,23 @@
croak "$func \$left and \$right are not the same!";
}
if (reftype $left eq 'HASH') {
- goto &merge_hash;
+ goto &_merge_hash;
} elsif (reftype $left eq 'ARRAY') {
- goto &merge_array;
+ goto &_merge_array;
} else {
croak "$func Can not merge a(n) ", reftype $left, " reference!";
}
}
# Author: bdonlan
-sub merge_hash ($$) {
- croak 'merge_hash($a,$b): $a and $b must be hashes!'
+sub _merge_hash ($$) {
+ croak '_merge_hash($a,$b): $a and $b must be hashes!'
unless reftype($_[0]) eq 'HASH' and reftype($_[1]) eq 'HASH';
my ($left, $right) = @_;
my %merged = %$left;
for (keys %$right) {
if (exists $merged{$_}) {
- $merged{$_} = merge_struct($merged{$_}, $right->{$_});
+ $merged{$_} = _merge_struct($merged{$_}, $right->{$_});
} else {
$merged{$_} = $right->{$_};
}
@@ -76,8 +97,8 @@
}
# Author: bdonlan
-sub merge_array ($$) {
- croak 'merge_array($a, $b): $a and $b must be arrays!'
+sub _merge_array ($$) {
+ croak '_merge_array($a, $b): $a and $b must be arrays!'
unless reftype($_[0]) eq 'ARRAY' and reftype($_[1]) eq 'ARRAY';
my ($left, $right) = @_;
return [EMAIL PROTECTED], @$right];
@@ -93,9 +114,9 @@
=head1 SYNOPSIS
use Haver::Config;
- my $ch = new Haver::Config(
- file => "$ENV{HOME}/.myconfigfile",
- default => {
+ my $ch = new Haver::Config (
+ load => "$ENV{HOME}/.myconfigfile",
+ merge => {
name => $ENV{USER},
stuff => [1,2,3],
},
@@ -116,40 +137,58 @@
Haver::Config extends L<Haver::Base>.
-=head1 PARAMETERS
+=head1 METHODS
-The constructor new() takes the following parameters:
+This class uses L<Spiffy> indirectly, and thus methods and parameters to the
constructor new()
+are the same thing. Thus you may write:
-=head2 -file
+ $ch = new Haver::Config ( load => 'foobar' );
-The name of the config file to use.
+Instead of:
-=head2 -default
+ $ch = new Haver::Config;
+ $ch->load('foobar');
-A hash to merge the config file with. This specifies the default values
-for the application.
+The following methods are public:
-=head1 METHODS
+=head2 load($file)
-This class implements the following methods:
+Load the file $file into memory. This overwrites whatever config data is
already loaded.
-=head2 load($file)
+=head2 save(Z<>)
-This loads the file $file. Note that:
+Save the config data to the most recently loaded file.
- my $ch = new Haver::Config;
- $ch->load('foo')
+=head2 reload(Z<>)
-is equivelent to:
+Reload the most recently loaded file.
- my $ch = new Haver::Config(-file => 'foo');
+=head2 file(Z<>)
-=head2 save($file)
+Return the name of the most recently loaded file.
-Save the config hash to $file. If $file is undefined,
-it defaults to the file that the config was loaded from most recently.
-If a file has never been loaded, it will croak.
+=head2 merge($hash)
+Recursively merge $hash with the loaded config data.
+This should be called after load(). Already loaded data has precedence over
$hash.
+
+=head2 config(Z<>)
+
+Return the currently loaded config data.
+
+=head2 get($key)
+
+This is shorthand for C<$self-E<gt>config-E<gt>{$key}>, except it is
marginally faster
+and perhaps safer to use.
+
+=head2 set($key => $value)
+
+Like get(), this is shorthand for C<$self-E<gt>config-E<gt>{$key} = $value>.
+
+=head2 del($key)
+
+Finally, this is shorthand for C<delete $self-E<gt>config-E<gt>{$key}>.
+
=head1 BUGS
None known. Bug reports are welcome. Please use our bug tracker at
@@ -157,7 +196,8 @@
=head1 AUTHOR
-Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
+Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
+Bryan Donlan, E<lt>[EMAIL PROTECTED]<gt>.
=head1 SEE ALSO
@@ -165,7 +205,8 @@
=head1 COPYRIGHT and LICENSE
-Copyright (C) 2005 by Dylan William Hardison. All Rights Reserved.
+Copyright 2005 by Dylan William Hardison. All Rights Reserved.
+Copyright 2005 by Bryan Donlan. All Rights Reserved.
This module is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
Modified: trunk/perl/core/lib/Haver/Wheel.pm
===================================================================
--- trunk/perl/core/lib/Haver/Wheel.pm 2005-06-21 02:49:41 UTC (rev 785)
+++ trunk/perl/core/lib/Haver/Wheel.pm 2005-06-21 06:40:14 UTC (rev 786)
@@ -20,7 +20,7 @@
);
const kernel => $POE::Kernel::poe_kernel;
-field package => 1;
+field package => 0;
sub new {
my $class = shift;
@@ -105,7 +105,7 @@
if exists $self->{_defined_states}{$state};
$self->{_defined_states}{$state} = $method;
$kernel->state($state,
- $self->{package} ? ref $self : $self,
+ $self->package ? ref $self : $self,
$method
);
}
Modified: trunk/perl/core/t/001_config.t
===================================================================
--- trunk/perl/core/t/001_config.t 2005-06-21 02:49:41 UTC (rev 785)
+++ trunk/perl/core/t/001_config.t 2005-06-21 06:40:14 UTC (rev 786)
@@ -5,23 +5,39 @@
# change 'tests => 1' to 'tests => last_test_to_print';
-use Test::More tests => 3;
+use Test::More tests => 6;
BEGIN {
use_ok('Haver::Config');
};
-can_ok('Haver::Config', 'new', 'config');
+can_ok('Haver::Config', qw(
+ new config get set load save reload file merge
+));
-my $d =
-my $ch = new Haver::Config (
- file => 'foobar',
- default => {
+
+if (-e 'foobar') {
+ unlink 'foobar' or die "Can't remove foobar!";
+}
+my $ch = new Haver::Config;
+$ch->load('foobar');
+$ch->merge(
+ {
stuff => {
monkeys => 2,
},
foo => 'bar',
- },
+ }
);
my $c = $ch->config;
is_deeply($c, { stuff => { monkeys => 2 }, foo => 'bar' }, "Config with
default values");
+ok(($ch->get('foo') eq 'bar'), "get()");
+$ch->set(bar => 'baz');
+ok(($ch->get('bar') eq 'baz'), "get()");
+
+$ch->save;
+
+my $ch2 = new Haver::Config;
+$ch2->load('foobar');
+
+is_deeply($ch->config, $ch2->config, "Saved properly");
Modified: trunk/perl/core/t/003_wheel.t
===================================================================
--- trunk/perl/core/t/003_wheel.t 2005-06-21 02:49:41 UTC (rev 785)
+++ trunk/perl/core/t/003_wheel.t 2005-06-21 06:40:14 UTC (rev 786)
@@ -2,7 +2,7 @@
# vim: set ft=perl:
use strict;
use POE;
-use Test::More tests => 13;
+use Test::More tests => 14;
BEGIN {
use_ok('Haver::Wheel');
@@ -39,46 +39,7 @@
);
-BEGIN {
- package MyWheel;
- use POE;
- use base 'Haver::Wheel';
- sub setup {
- my $self = shift;
- $self->provide('foo', 'on_foo');
- $self->provide('bar', 'on_bar');
- $self->provide('baz', 'on_baz');
- }
-
- sub on_load {
- my $self = $_[OBJECT];
- $self->{load} = 1;
- }
-
- sub on_unload {
- my $self = $_[OBJECT];
- $self->{unload} = 1;
- }
- sub on_foo {
- my $self = $_[OBJECT];
- $self->{foo}++;
- }
-
- sub on_bar {
- my $self = $_[OBJECT];
- $self->{bar}++;
- }
-
- sub on_baz {
- my $self = $_[OBJECT];
- $self->{baz}++;
- if ($self->{baz} == 1) {
- $_[KERNEL]->yield('bye');
- }
- }
-}
-
POE::Session->create(
inline_states => {
_start => \&on_start,
@@ -87,18 +48,20 @@
},
);
-POE::Kernel->run;
sub on_start {
my ($kernel, $heap) = @_[KERNEL, HEAP];
my $loader = new Haver::Wheel::Loader;
$loader->load_wheel('MyWheel');
+ $loader->load_wheel('PkgWheel');
$heap->{loader} = $loader;
+
diag "Starting session";
foreach my $state (qw( foo bar baz )) {
$kernel->yield($state) for 1 .. 3;
}
+ $kernel->yield('gork');
}
sub on_stop {
@@ -125,4 +88,68 @@
isnt($p->{foo}, 5, "foo is not 5");
ok($p->{load}, "on_load was called.");
ok($p->{unload}, "on_unload was called.");
+ ok(($PkgWheel::Gork == 1), 'package wheel worked');
}
+
+
+
+
+POE::Kernel->run;
+
+BEGIN {
+ package MyWheel;
+ use POE;
+ use base 'Haver::Wheel';
+
+ sub setup {
+ my $self = shift;
+ $self->provide('foo', 'on_foo');
+ $self->provide('bar', 'on_bar');
+ $self->provide('baz', 'on_baz');
+ }
+
+ sub on_load {
+ my $self = $_[OBJECT];
+ $self->{load} = 1;
+ }
+
+ sub on_unload {
+ my $self = $_[OBJECT];
+ $self->{unload} = 1;
+ }
+ sub on_foo {
+ my $self = $_[OBJECT];
+ $self->{foo}++;
+ }
+
+ sub on_bar {
+ my $self = $_[OBJECT];
+ $self->{bar}++;
+ }
+
+ sub on_baz {
+ my $self = $_[OBJECT];
+ $self->{baz}++;
+ if ($self->{baz} == 1) {
+ $_[KERNEL]->yield('bye');
+ }
+ }
+}
+
+
+BEGIN {
+ package PkgWheel;
+ use POE;
+ use Test::More;
+ use Haver::Wheel -base;
+ our $Gork = 0;
+
+ sub setup {
+ my $self = shift;
+ $self->provide('gork', 'on_gork');
+ }
+ sub package { 1 }
+ sub on_gork {
+ $Gork = ($_[OBJECT] eq 'PkgWheel');
+ }
+}
