Added rule to catch a default value given just as "null."

[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Utils.pm

diff --git a/lib/SQL/Translator/Utils.pm b/lib/SQL/Translator/Utils.pm
index d5d3dcd..b7180c6 100644 (file)
--- a/lib/SQL/Translator/Utils.pm
+++ b/lib/SQL/Translator/Utils.pm
@@ -1,7 +1,7 @@
 package SQL::Translator::Utils;
 
 # ----------------------------------------------------------------------
-# $Id: Utils.pm,v 1.2 2003-04-17 13:41:36 dlc Exp $
+# $Id: Utils.pm,v 1.7 2003-05-12 15:47:23 dlc Exp $
 # ----------------------------------------------------------------------
 # Copyright (C) 2003 darren chamberlain <darren@cpan.org>
 #
@@ -22,12 +22,15 @@ package SQL::Translator::Utils;
 
 use strict;
 use base qw(Exporter);
-use vars qw($VERSION @EXPORT_OK);
+use vars qw($VERSION $DEFAULT_COMMENT @EXPORT_OK);
 
 use Exporter;
 
 $VERSION = 1.00;
-@EXPORT_OK = ('debug', 'normalize_name');
+$DEFAULT_COMMENT = '-- ';
+@EXPORT_OK = qw(
+    debug normalize_name header_comment parse_list_arg $DEFAULT_COMMENT
+);
 
 # ----------------------------------------------------------------------
 # debug(@msg)
@@ -48,7 +51,7 @@ $VERSION = 1.00;
 # If called from Translator.pm, on line 643.
 # ----------------------------------------------------------------------
 sub debug {
-    my ($pkg, $file, $line, $sub) = caller(1);
+    my ($pkg, $file, $line, $sub) = caller(0);
     {
         no strict qw(refs);
         return unless ${"$pkg\::DEBUG"};
@@ -67,7 +70,7 @@ sub debug {
     }
 }
 
-
+# ----------------------------------------------------------------------
 sub normalize_name {
     my $name = shift;
 
@@ -88,9 +91,45 @@ sub normalize_name {
     return $name;
 }
 
+# ----------------------------------------------------------------------
+sub header_comment {
+    my $producer = shift || caller;
+    my $comment_char = shift;
+    my $now = scalar localtime;
+
+    $comment_char = $DEFAULT_COMMENT
+        unless defined $comment_char;
+
+    my $header_comment =<<"HEADER_COMMENT";
+${comment_char}
+${comment_char}Created by $producer
+${comment_char}Created on $now
+${comment_char}
+HEADER_COMMENT
+
+    # Any additional stuff passed in
+    for my $additional_comment (@_) {
+        $header_comment .= "${comment_char}${additional_comment}\n";
+    }
+
+    return $header_comment;
+}
+
+# ----------------------------------------------------------------------
+sub parse_list_arg {
+    my $list = UNIVERSAL::isa( $_[0], 'ARRAY' ) ? shift : [ @_ ];
+
+    return [ map { s/^\s+|\s+$//g; $_ }
+             map { split /,/ }
+             grep { defined && length } @$list
+           ];
+}
+
 1;
 
-__END__
+# ----------------------------------------------------------------------
+
+=pod
 
 =head1 NAME
 
@@ -106,16 +145,16 @@ SQL::Translator::Utils - SQL::Translator Utility functions
 C<SQL::Translator::Utils> contains utility functions designed to be
 used from the other modules within the C<SQL::Translator> modules.
 
-No functions are exported by default.
+Nothing is exported by default.
 
-=head1 EXPORTED FUNCTIONS
+=head1 EXPORTED FUNCTIONS AND CONSTANTS
 
 =head2 debug
 
 C<debug> takes 0 or more messages, which will be sent to STDERR using
 C<warn>.  Occurances of the strings I<PKG>, I<SUB>, and I<LINE>
 will be replaced by the calling package, subroutine, and line number,
-respectively, as reported by C<caller(1)>.  
+respectively, as reported by C<caller(1)>.
 
 For example, from within C<foo> in F<SQL/Translator.pm>, at line 666:
 
@@ -153,3 +192,56 @@ returns:
 
   silly_field_with_random_characters
 
+=head2 header_comment
+
+Create the header comment.  Takes 1 mandatory argument (the producer
+classname), an optional comment character (defaults to $DEFAULT_COMMENT),
+and 0 or more additional comments, which will be appended to the header,
+prefixed with the comment character.  If additional comments are provided,
+then a comment string must be provided ($DEFAULT_COMMENT is exported for
+this use).  For example, this:
+
+  package My::Producer;
+
+  use SQL::Translator::Utils qw(header_comment $DEFAULT_COMMENT);
+
+  print header_comment(__PACKAGE__,
+                       $DEFAULT_COMMENT,
+                       "Hi mom!");
+
+produces:
+
+  --
+  -- Created by My::Prodcuer
+  -- Created on Fri Apr 25 06:56:02 2003
+  --
+  -- Hi mom!
+  --
+
+Note the gratuitous spacing.
+
+=head2 parse_list_arg
+
+Takes a string, list or arrayref (all of which could contain
+comma-separated values) and returns an array reference of the values.
+All of the following will return equivalent values:
+
+  parse_list_arg('id');
+  parse_list_arg('id', 'name');
+  parse_list_arg( 'id, name' );
+  parse_list_arg( [ 'id', 'name' ] );
+  parse_list_arg( qw[ id name ] );
+
+=head2 $DEFAULT_COMMENT
+
+This is the default comment string, '-- ' by default.  Useful for
+C<header_comment>.
+
+=head1 AUTHORS
+
+Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
+Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
+
+=cut
+
+=cut