X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FUtils.pm;h=cefa2846445ba10754056a24971e049d6dd917a8;hb=383067ff7eea362432f044a3a7f054664b235f68;hp=d5d3dcdb3b2a4ff95c0e2182407a2498eb9f8340;hpb=93d12e9cc6802a202805db212caa0a01913a90dc;p=dbsrgits%2FSQL-Translator.git

diff --git a/lib/SQL/Translator/Utils.pm b/lib/SQL/Translator/Utils.pm
index d5d3dcd..cefa284 100644
--- a/lib/SQL/Translator/Utils.pm
+++ b/lib/SQL/Translator/Utils.pm
@@ -1,9 +1,9 @@
 package SQL::Translator::Utils;
 
 # ----------------------------------------------------------------------
-# $Id: Utils.pm,v 1.2 2003-04-17 13:41:36 dlc Exp $
+# $Id: Utils.pm,v 1.12 2004-02-09 23:04:26 kycl4rk Exp $
 # ----------------------------------------------------------------------
-# Copyright (C) 2003 darren chamberlain <darren@cpan.org>
+# Copyright (C) 2002-4 SQLFairy Authors
 #
 # This program is free software; you can redistribute it and/or
 # modify it under the terms of the GNU General Public License as
@@ -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');
+$VERSION = sprintf "%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/;
+$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,9 +70,9 @@ sub debug {
     }
 }
 
-
+# ----------------------------------------------------------------------
 sub normalize_name {
-    my $name = shift;
+    my $name = shift or return '';
 
     # The name can only begin with a-zA-Z_; if there's anything
     # else, prefix with _
@@ -88,9 +91,63 @@ 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;
+}
+
+# ----------------------------------------------------------------------
+# parse_list_arg
+#
+# Meant to accept a list, an array reference, or a string of 
+# comma-separated values.  Retuns an array reference of the 
+# arguments.  Modified to also handle a list of references.
+# ----------------------------------------------------------------------
+sub parse_list_arg {
+    my $list = UNIVERSAL::isa( $_[0], 'ARRAY' ) ? shift : [ @_ ];
+
+    #
+    # This protects stringification of references.
+    #
+    if ( @$list && ref $list->[0] ) {
+        return $list;
+    }
+    #
+    # This processes string-like arguments.
+    #
+    else {
+        return [ 
+            map { s/^\s+|\s+$//g; $_ }
+            map { split /,/ }
+            grep { defined && length } @$list
+        ];
+    }
+}
+
 1;
 
-__END__
+# ----------------------------------------------------------------------
+
+=pod
 
 =head1 NAME
 
@@ -106,16 +163,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 +210,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