svn commit: r802060 - in /lucene/lucy/trunk/boilerplater: ./ lib/ lib/Boilerplater/ lib/Boilerplater/Util.pm t/ t/000-load.t t/001-util.t

[ma...@apache.org]

Author: marvin
Date: Fri Aug  7 16:04:16 2009
New Revision: 802060

URL: http://svn.apache.org/viewvc?rev=802060&view=rev
Log:
Add trunk/boilerplater directory.  Add Boilerplater::Util, plus a fail-fast
module load test.

Added:
    lucene/lucy/trunk/boilerplater/
    lucene/lucy/trunk/boilerplater/lib/
    lucene/lucy/trunk/boilerplater/lib/Boilerplater/
    lucene/lucy/trunk/boilerplater/lib/Boilerplater/Util.pm   (with props)
    lucene/lucy/trunk/boilerplater/t/
    lucene/lucy/trunk/boilerplater/t/000-load.t   (with props)
    lucene/lucy/trunk/boilerplater/t/001-util.t   (with props)

Added: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Util.pm
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/boilerplater/lib/Boilerplater/Util.pm?rev=802060&view=auto
==============================================================================
--- lucene/lucy/trunk/boilerplater/lib/Boilerplater/Util.pm (added)
+++ lucene/lucy/trunk/boilerplater/lib/Boilerplater/Util.pm Fri Aug  7 16:04:16 2009
@@ -0,0 +1,151 @@
+use strict;
+use warnings;
+
+package Boilerplater::Util;
+use base qw( Exporter );
+use Scalar::Util qw( blessed );
+use Carp;
+
+our @EXPORT_OK = qw(
+    slurp_file
+    current
+    strip_c_comments
+    verify_args
+    a_isa_b
+);
+
+sub slurp_file {
+    my $path = shift;
+    open( my $fh, '<', $path ) or confess("Can't open '$path': $!");
+    local $/;
+    return <$fh>;
+}
+
+sub current {
+    my ( $orig, $dest ) = @_;
+    my $bubble_time = time;
+    $orig = [$orig] unless ref($orig) eq 'ARRAY';
+    $dest = [$dest] unless ref($dest) eq 'ARRAY';
+
+    # If a destination file doesn't exist, we're not current.
+    for (@$dest) {
+        return 0 unless -e $_;
+    }
+
+    # Find the oldest file from the destination group.
+    for (@$dest) {
+        my $candidate = ( stat($_) )[9];
+        $bubble_time = $candidate if $candidate < $bubble_time;
+    }
+
+    # If any source file is newer than the oldest dest, we're not current.
+    for (@$orig) {
+        confess "Missing source file '$_'" unless -e $_;
+        my $candidate = ( stat($_) )[9];
+        return 0 if $candidate > $bubble_time;
+    }
+
+    # Current!
+    return 1;
+}
+
+sub strip_c_comments {
+    my $c_code = shift;
+    $c_code =~ s#/\*.*?\*/##gsm;
+    return $c_code;
+}
+
+sub verify_args {
+    my $defaults = shift;    # leave the rest of @_ intact
+
+    # Verify that args came in pairs.
+    if ( @_ % 2 ) {
+        my ( $package, $filename, $line ) = caller(1);
+        $@ = "Parameter error: odd number of args at $filename line $line\n";
+        return 0;
+    }
+
+    # Verify keys, ignore values.
+    while (@_) {
+        my ( $var, undef ) = ( shift, shift );
+        next if exists $defaults->{$var};
+        my ( $package, $filename, $line ) = caller(1);
+        $@ = "Invalid parameter: '$var' at $filename line $line\n";
+        return 0;
+    }
+
+    return 1;
+}
+
+sub a_isa_b {
+    my ( $thing, $class ) = @_;
+    return 0 unless blessed($thing);
+    return $thing->isa($class);
+}
+
+1;
+
+__END__
+
+__POD__
+
+=head1 NAME
+
+Boilerplater::Util - Miscellaneous helper functions.
+
+=head1 DESCRIPTION
+
+Boilerplater::Util provides a few convenience functions used internally by
+other Boilerplater modules.
+
+=head1 FUNCTIONS
+
+=head2 slurp_file
+
+    my $foo_contents = slurp_file('foo.txt');
+
+Open a file, read it in, return its contents.  Assumes either binary data or
+text with an encoding of Latin-1.
+
+=head2 current
+
+    compile('foo.c') unless current( 'foo.c', 'foo.o' );
+
+Given two elements, which may be either scalars or arrays, verify that
+everything in the second group exists and was created later than anything in
+the first group.
+
+=head2 verify_args
+
+    verify_args( \%defaults, @_ ) or confess $@;
+
+Verify that named parameters exist in a defaults hash.  Returns false and sets
+$@ if a problem is detected.
+
+=head2 strip_c_comments
+
+    my $c_minus_comments = strip_c_comments($c_source_code);
+
+Quick 'n' dirty stripping of C comments.  Will massacre stuff like comments
+embedded in string literals, so watch out.
+
+=head1 COPYRIGHT AND LICENSE
+
+    /**
+     * Copyright 2009 The Apache Software Foundation
+     *
+     * Licensed under the Apache License, Version 2.0 (the "License");
+     * you may not use this file except in compliance with the License.
+     * You may obtain a copy of the License at
+     *
+     *     http://www.apache.org/licenses/LICENSE-2.0
+     *
+     * Unless required by applicable law or agreed to in writing, software
+     * distributed under the License is distributed on an "AS IS" BASIS,
+     * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+     * implied.  See the License for the specific language governing
+     * permissions and limitations under the License.
+     */
+
+=cut
+

Propchange: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Util.pm
------------------------------------------------------------------------------
    svn:eol-style = native

Propchange: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Util.pm
------------------------------------------------------------------------------
    svn:executable = *

Added: lucene/lucy/trunk/boilerplater/t/000-load.t
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/boilerplater/t/000-load.t?rev=802060&view=auto
==============================================================================
--- lucene/lucy/trunk/boilerplater/t/000-load.t (added)
+++ lucene/lucy/trunk/boilerplater/t/000-load.t Fri Aug  7 16:04:16 2009
@@ -0,0 +1,24 @@
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+use File::Find 'find';
+
+my @modules;
+
+find(
+    {   no_chdir => 1,
+        wanted   => sub {
+            return unless $File::Find::name =~ /\.pm$/;
+            push @modules, $File::Find::name;
+            }
+    },
+    'lib'
+);
+for (@modules) {
+    s/^.*?Boilerplater/Boilerplater/;
+    s/\.pm$//;
+    s/\W+/::/g;
+    use_ok($_);
+}
+

Propchange: lucene/lucy/trunk/boilerplater/t/000-load.t
------------------------------------------------------------------------------
    svn:eol-style = native

Added: lucene/lucy/trunk/boilerplater/t/001-util.t
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/boilerplater/t/001-util.t?rev=802060&view=auto
==============================================================================
--- lucene/lucy/trunk/boilerplater/t/001-util.t (added)
+++ lucene/lucy/trunk/boilerplater/t/001-util.t Fri Aug  7 16:04:16 2009
@@ -0,0 +1,46 @@
+use strict;
+use warnings;
+
+use Test::More tests => 14;
+use Boilerplater::Util qw(
+    slurp_file
+    current
+    verify_args
+    strip_c_comments
+    a_isa_b
+);
+
+my $foo_txt = 'foo.txt';
+unlink $foo_txt;
+open( my $fh, '>', $foo_txt ) or die "Can't open '$foo_txt': $!";
+print $fh "foo";
+close $fh or die "Can't close '$foo_txt': $!";
+is( slurp_file($foo_txt), "foo", "slurp_file" );
+
+ok( current( $foo_txt, $foo_txt ), "current" );
+ok( !current( $foo_txt, 't' ), "not current" );
+ok( !current( 'foo.txt', "nonexistent_file" ),
+    "not current when dest file mising"
+);
+
+unlink $foo_txt;
+
+my $comment    = "/* I have nothing to say to you, world. */\n";
+my $no_comment = "\n";
+is( strip_c_comments($comment), $no_comment, "strip_c_comments" );
+
+my %defaults = ( foo => undef );
+sub test_verify_args { return verify_args( \%defaults, @_ ) }
+
+ok( test_verify_args( foo => 'foofoo' ), "args verified" );
+ok( !test_verify_args('foo'), "odd args fail verification" );
+like( $@, qr/odd/, 'set $@ on odd arg failure' );
+ok( !test_verify_args( bar => 'nope' ), "bad param doesn't verify" );
+like( $@, qr/param/, 'set $@ on invalid param failure' );
+
+my $foo = bless {}, 'Foo';
+ok( a_isa_b( $foo, 'Foo' ), "a_isa_b true" );
+ok( !a_isa_b( $foo,  'Bar' ), "a_isa_b false" );
+ok( !a_isa_b( 'Foo', 'Foo' ), "a_isa_b not blessed" );
+ok( !a_isa_b( undef, 'Foo' ), "a_isa_b undef" );
+

Propchange: lucene/lucy/trunk/boilerplater/t/001-util.t
------------------------------------------------------------------------------
    svn:eol-style = native