Author: dylan
Date: 2004-06-26 21:35:19 -0400 (Sat, 26 Jun 2004)
New Revision: 247
Modified:
trunk/main/common/lib/Haver/Savable.pm
trunk/main/common/lib/Haver/Util/Logger.pm
trunk/main/common/lib/Haver/Util/Misc.pm
trunk/main/common/lib/Haver/Util/Reload.pm
Log:
Haver::Savable: Working on adding default handling.
Haver::Util::Reload: Changed package name to match file name.
Haver::Util::Misc: Added parse_datetime function, and bd_'s
merge_struct functions.
Haver::Util::Logger: Added assertion.
Modified: trunk/main/common/lib/Haver/Savable.pm
===================================================================
--- trunk/main/common/lib/Haver/Savable.pm 2004-06-27 01:28:33 UTC (rev
246)
+++ trunk/main/common/lib/Haver/Savable.pm 2004-06-27 01:35:19 UTC (rev
247)
@@ -34,7 +34,8 @@
my ($me) = @_;
$me->{_mtime} = -1;
- $me->{_overwrite} = 0;
+ $me->{_overwrite} = 0;
+ $me->{_default} = delete $me->{default};
}
sub load {
@@ -76,6 +77,10 @@
}
sub _init_data {
+ my ($me) = @_;
+
+ if ($me->{_default}) {
+ }
}
sub save {
Modified: trunk/main/common/lib/Haver/Util/Logger.pm
===================================================================
--- trunk/main/common/lib/Haver/Util/Logger.pm 2004-06-27 01:28:33 UTC (rev
246)
+++ trunk/main/common/lib/Haver/Util/Logger.pm 2004-06-27 01:35:19 UTC (rev
247)
@@ -29,9 +29,10 @@
sub create {
my $class = shift;
- #ASSERT: (@_ == 1) or ((@_ % 2) == 0);
+ # ASSERT: (@_ == 1 and ref($_[0]) eq 'HASH') or ((@_ % 2) == 0);
my $opts = @_ == 1 ? $_[0] : { @_ };
+
create POE::Session (
package_states => [
$Package => {
Modified: trunk/main/common/lib/Haver/Util/Misc.pm
===================================================================
--- trunk/main/common/lib/Haver/Util/Misc.pm 2004-06-27 01:28:33 UTC (rev
246)
+++ trunk/main/common/lib/Haver/Util/Misc.pm 2004-06-27 01:35:19 UTC (rev
247)
@@ -1,6 +1,6 @@
-# Haver::Misc - Various routines
+# Haver::Util::Misc - Various routines
#
-# Copyright (C) 2004 Dylan William Hardison
+# Copyright (C) 2004 Dylan William Hardison, Bryan Donlan
#
# 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
@@ -15,31 +15,87 @@
# You should have received a copy of the GNU General Public License
# along with this module; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-package Haver::Misc;
+package Haver::Util::Misc;
use strict;
#use warnings;
use Haver::Preprocessor;
use POSIX qw( strftime );
use Carp;
use Exporter;
+use Scalar::Util qw(reftype);
use base 'Exporter';
-
-our @EXPORT_OK = qw( format_datetime randint rand );
-our $VERSION = '0.01';
+our @EXPORT_OK = qw( format_datetime merge_struct parse_datetime );
+our $VERSION = 0.02;
our $RELOAD = 1;
+# Author: dylan
sub format_datetime {
# dylan: Because bd_ thought it should work this way...
- #ASSERT: @_ <= 1;
+ # ASSERT: @_ <= 1;
my $now = @_ ? shift : time;
strftime('%Y-%m-%d %H:%M:%S %z', localtime($now));
}
+
sub parse_datetime {
- # WRITEME
+ # ASSERT: @ == 1;
+ my $str = shift;
+ require Date::Parse;
+ # patterns
+ my $date = qr/(\d{4})-(\d\d)-(\d\d)/;
+ my $time = qr/(\d\d):(\d\d):(\d\d)/;
+ my $tz = qr/([+-])(\d{4})/;
+
+ if ($str =~ /^$date $time $tz$/) {
+ return Date::Parse::str2time($str);
+ } else {
+ croak "Datetime format is invalid!";
+ }
}
+# Author: bdonlan
+sub merge_struct {
+ # ASSERT: @_ == 2;
+ my ($left, $right) = @_;
+ my $func = "merge_struct(\$left,\$right):";
+
+ unless (ref $left and ref $right) {
+ return $left;
+ }
+
+ if (reftype $left ne reftype $right) {
+ croak "$func \$left and \$right are not the same!";
+ }
+ if (reftype $left eq 'HASH') {
+ goto &merge_hash;
+ } elsif (reftype $left eq 'ARRAY') {
+ goto &merge_array;
+ } else {
+ croak "$func Can not merge a(n) ", reftype $left, " reference!";
+ }
+}
+
+# Author: bdonlan
+sub merge_hash {
+ my ($left, $right) = @_;
+ my %merged = %$left;
+ for (keys %$right) {
+ if (exists $merged{$_}) {
+ $merged{$_} = merge_struct($merged{$_}, $right->{$_});
+ } else {
+ $merged{$_} = $right->{$_};
+ }
+ }
+ return \%merged;
+}
+
+# Author: bdonlan
+sub merge_array {
+ my ($left, $right) = @_;
+ return [EMAIL PROTECTED], @$right];
+}
+
1;
Modified: trunk/main/common/lib/Haver/Util/Reload.pm
===================================================================
--- trunk/main/common/lib/Haver/Util/Reload.pm 2004-06-27 01:28:33 UTC (rev
246)
+++ trunk/main/common/lib/Haver/Util/Reload.pm 2004-06-27 01:35:19 UTC (rev
247)
@@ -1,4 +1,4 @@
-# Haver::Reload - Reload modules.
+# Haver::Util::Reload - Reload modules.
#
# Copyright (C) 2004 Dylan William Hardison
#
@@ -15,7 +15,7 @@
# You should have received a copy of the GNU General Public License
# along with this module; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-package Haver::Reload;
+package Haver::Util::Reload;
use strict;
use warnings;
use File::stat;
@@ -115,23 +115,23 @@
=head1 NAME
-Haver::Reload - Reload modules if needed
+Haver::Util::Reload - Reload modules if needed
=head1 SYNOPSIS
- use Haver::Reload;
- Haver::Reload->init;
+ use Haver::Util::Reload;
+ Haver::Util::Reload->init;
# Now, reload things:
- my @did = Haver::Reload->reload;
+ my @did = Haver::Util::Reload->reload;
# @did is a list of modules we reloaded.
# change the default module matching pattern:
- Haver::Reload->pattern(qr/^MyMod::/);
+ Haver::Util::Reload->pattern(qr/^MyMod::/);
# Try to load a module at run-time:
- if (Haver::Reload->load('Haver::Server::Monkey')) {
+ if (Haver::Util::Reload->load('Haver::Server::Monkey')) {
print "OK!\n";
} else {
print "Can't load Haver::Server::Monkey!\n";
@@ -144,12 +144,12 @@
=head1 DESCRIPTION
This module reloads modules, if the module is reloadable and has changed
-since init() was last called. The module must also match
$Haver::Reload::Pattern,
+since init() was last called. The module must also match
$Haver::Util::Reload::Pattern,
which is a regexp thingy, made with qr//.
A module is considered reloadable if it contains a package global scalar
$RELOAD and if that said global is true.
-$Haver::Reload::Pattern defaults to qr/^Haver::/.
+$Haver::Util::Reload::Pattern defaults to qr/^Haver::/.
=head2 EXPORTS
