Author: dylan
Date: 2005-01-20 16:21:53 -0500 (Thu, 20 Jan 2005)
New Revision: 600
Removed:
trunk/main/core/lib/Haver/Preprocessor.pm
Modified:
trunk/main/core/lib/Haver/Base.pm
Log:
Haver::Preprocessor was a dumb idea.
Modified: trunk/main/core/lib/Haver/Base.pm
===================================================================
--- trunk/main/core/lib/Haver/Base.pm 2005-01-15 01:36:45 UTC (rev 599)
+++ trunk/main/core/lib/Haver/Base.pm 2005-01-20 21:21:53 UTC (rev 600)
@@ -1,27 +1,11 @@
-# Haver::Base - Base class for most objects in Haver.
-#
-# Copyright (C) 2004 Dylan William Hardison
-#
-# 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
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This module is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# 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
+# vim: set ts=4 sw=4 expandtab si ai sta tw=104:
+# This module is copyrighted, see end of file for details.
package Haver::Base;
use strict;
use warnings;
use Haver::Preprocessor;
our $VERSION = "0.01";
-use overload;
sub new {
my $this = shift;
@@ -45,6 +29,8 @@
return $me;
}
+
+
sub initialize {undef}
sub finalize {undef}
@@ -102,6 +88,8 @@
=head1 METHODS
+Haver::Base implements the following methods:
+
=head2 $class->new(%options)
This constructor method creates and returns a new I<$class>,
@@ -119,6 +107,8 @@
=head1 VIRTUAL METHODS
+The following methods may be defined by subclasses:
+
=head2 $self->initialize(@args)
This is called by new(), and should
@@ -129,8 +119,6 @@
In practice, no current subclass of Haver::Base
has an initalize method that takes arguments.
-A subclass does not have to implement this method.
-
=head2 $self->finalize(Z<>)
This method is called from DESTROY().
@@ -142,8 +130,6 @@
=head1 SEE ALSO
-L<Haver::Singleton>
-
L<https://gna.org/projects/haver/>
@@ -153,7 +139,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright (C) 2004 by Dylan William Hardison
+Copyright (C) 2004, 2005 by Dylan William Hardison
This library is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
Deleted: trunk/main/core/lib/Haver/Preprocessor.pm
===================================================================
--- trunk/main/core/lib/Haver/Preprocessor.pm 2005-01-15 01:36:45 UTC (rev
599)
+++ trunk/main/core/lib/Haver/Preprocessor.pm 2005-01-20 21:21:53 UTC (rev
600)
@@ -1,177 +0,0 @@
-# Haver::Preprocessor - simple preprocessor for Haver scripts.
-#
-# Copyright (C) 2004 Dylan William Hardison
-#
-# 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
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This module is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# 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::Preprocessor;
-use strict;
-use warnings;
-use Carp;
-
-use Filter::Simple;
-our $Did;
-our %Option = (
- assert => 0,
- debug => undef,
- rtdebug => 0,
- verbose => 0,
- levels => {},
- name => 0,
-);
-
-FILTER {
- if ($Option{assert}) {
- s/^\s*#?\s*ASSERT(?:\((.+?)\))?:\s*(.+?);$/assert($1, $2)/meg;
- } else {
- s/^\s*#?\s*ASSERT(?:\((.+?)\))?:/# ASSERT:/mg;
- }
-
- if (defined $Option{debug}) {
- s/^\s*#?\s*DEBUG(?:\((\w+?)\))?:\s*(.+?);\s*$/debug($1, $2)/meg;
- } else {
- s/^\s*#?\s*DEBUG(?:\(\s*(\w+?)\s*\))?:/# DEBUG:/mg;
- }
-};
-
-sub import {
- my ($class, @args) = @_;
- my @keys;
-
- while (my $arg = shift @args) {
- my $opt = $arg;
- if ($opt =~ s/-no//) {
- $Option{$opt} = 0;
- } elsif ($opt =~ s/^-//) {
- if (exists $Option{$opt}) {
- if (not @args or $args[0] =~ /^-/) {
- if ($opt eq 'debug') {
- $Option{$opt} = 'ALL';
- } else {
- $Option{$opt}++;
- }
- } else {
- $Option{$opt} = shift @args;
- }
- } else {
- croak "Unknown option: $arg";
- }
- push(@keys, $opt);
- }
- }
-
- if ($Option{verbose} and @keys) {
- print STDERR __PACKAGE__, ":\n",
- map { sprintf " %-8s = %s\n", uc($_),
what($Option{$_}) } sort keys %Option;
- }
-}
-
-
-sub show {
- print STDERR __PACKAGE__, ": ", join(', ', @_), "\n";;
-}
-
-sub what {
- my $v = shift;
- return $v;
-}
-
-
-sub debug {
- my ($level, $rest) = @_;
- my $name;
-
- if ($Option{name}) {
- my $l = defined $level ? $level : '*';
- $name = "'($l) ', ";
- } else {
- $name = '';
- }
-
-
- if ($Option{rtdebug}) {
- my $str;
- if (not defined $level) {
- $str = 'undef';
- } elsif (not ($level =~ /^\d+$/)) {
- $str = $level;
- $str =~ s/'/\\'/g;
- $str = "'$str'";
- }
- my $if = "if Haver::Preprocessor::check($str)";
- return qq(print STDERR $name $rest, "\n" $if;);
- } elsif (check($level)) {
- return qq{print STDERR $name $rest, "\n";};
- } else {
- return qq{#DEBUG:};
- }
-}
-
-sub check {
- my ($level) = @_;
- my $l = level($level);
-
- if ($l != 0 and $l <= level($Option{debug})) {
- return 1;
- } else {
- return 0;
- }
-}
-
-sub level {
- my ($level) = @_;
-
- if (not defined $level) {
- return level("DEFAULT");
- } elsif ($level =~ /^\d+$/) {
- return $level;
- } elsif (exists $Option{levels}{$level}) {
- return $Option{levels}{$level};
- } elsif ($level eq "DEFAULT") {
- return 1;
- } elsif ($level eq "ALL" and %{ $Option{levels} }) {
- return max(values %{ $Option{levels} }) || 1;
- } else {
- return level("DEFAULT");
- }
-}
-
-sub max {
- my $max = 0;
- foreach (@_) {
- if ($max < $_) {
- $max = $_;
- }
- }
- return $max;
-}
-
-
-
-sub assert {
- my $msg = shift;
- my $cond = shift;
- my $s = ' ' x 18;
- my $code = <<CODE;
-unless ($cond) {no warnings;
-Carp::confess (q{Assertion failed: ($cond) at }, __FILE__, " line ",
__LINE__,
-"\\n",qq{\\tDetails: "$cond"},"\\n");
-}
-CODE
- $code =~ s/\n//sg;
- return $code;
-}
-
-
-1;
