NetWare tweaks from Guruprasad.
[p5sagit/p5-mst-13.2.git] / lib / Class / Struct.pm
index 554865a..5c68bf3 100644 (file)
@@ -5,6 +5,7 @@ package Class::Struct;
 use 5.005_64;
 
 use strict;
+use warnings::register;
 our(@ISA, @EXPORT, $VERSION);
 
 use Carp;
@@ -13,7 +14,7 @@ require Exporter;
 @ISA = qw(Exporter);
 @EXPORT = qw(struct);
 
-$VERSION = '0.58';
+$VERSION = '0.60';
 
 ## Tested on 5.002 and 5.003 without class membership tests:
 my $CHECK_CLASS_MEMBERSHIP = ($] >= 5.003_95);
@@ -50,6 +51,20 @@ sub printem {
     sub DESTROY { }
 }
 
+sub import {
+    my $self = shift;
+
+    if ( @_ == 0 ) {
+      $self->export_to_level( 1, $self, @EXPORT );
+    } elsif ( @_ == 1 ) {
+       # This is admittedly a little bit silly:
+       # do we ever export anything else than 'struct'...?
+      $self->export_to_level( 1, $self, @_ );
+    } else {
+      &struct;
+    }
+}
+
 sub struct {
 
     # Determine parameter list structure, one of:
@@ -75,6 +90,7 @@ sub struct {
         $class = (caller())[0];
         @decls = @_;
     }
+
     _usage_error() if @decls % 2 == 1;
 
     # Ensure we are not, and will not be, a subclass.
@@ -167,8 +183,7 @@ sub struct {
     $cnt = 0;
     foreach $name (@methods){
         if ( do { no strict 'refs'; defined &{$class . "::$name"} } ) {
-            carp "function '$name' already defined, overrides struct accessor method"
-                if $^W;
+            warnings::warnif("function '$name' already defined, overrides struct accessor method");
         }
         else {
             $pre = $pst = $cmt = $sel = '';
@@ -188,11 +203,13 @@ sub struct {
             if( defined $arrays{$name} ){
                 $out .= "    my \$i;\n";
                 $out .= "    \@_ ? (\$i = shift) : return \$r->$elem;\n"; 
+                $out .= "    if (ref(\$i) eq 'ARRAY' && !\@_) { \$r->$elem = \$i; return \$r }\n";
                 $sel = "->[\$i]";
             }
             elsif( defined $hashes{$name} ){
                 $out .= "    my \$i;\n";
-                $out .= "    \@_ ? (\$i = shift) : return \$r->$elem;\n"; 
+                $out .= "    \@_ ? (\$i = shift) : return \$r->$elem;\n";
+                $out .= "    if (ref(\$i) eq 'HASH' && !\@_) { \$r->$elem = \$i; return \$r }\n";
                 $sel = "->{\$i}";
             }
             elsif( defined $classes{$name} ){
@@ -242,6 +259,9 @@ Class::Struct - declare struct-like datatypes as Perl classes
             # declare struct, based on array, implicit class name:
     struct( ELEMENT_NAME => ELEMENT_TYPE, ... );
 
+    # Declare struct at compile time
+    use Class::Struct CLASS_NAME => [ ELEMENT_NAME => ELEMENT_TYPE, ... ];
+    use Class::Struct CLASS_NAME => { ELEMENT_NAME => ELEMENT_TYPE, ... };
 
     package Myobj;
     use Class::Struct;
@@ -262,14 +282,13 @@ Class::Struct - declare struct-like datatypes as Perl classes
                                     # hash type accessor:
     $hash_ref = $obj->h;                # reference to whole hash
     $hash_element_value = $obj->h('x'); # hash element value
-    $obj->h('x', 'new value');        # assign to hash element
+    $obj->h('x', 'new value');          # assign to hash element
 
                                     # class type accessor:
     $element_value = $obj->c;           # object reference
     $obj->c->method(...);               # call method of object
     $obj->c(new My_Other_Class);        # assign a new object
 
-
 =head1 DESCRIPTION
 
 C<Class::Struct> exports a single function, C<struct>.
@@ -287,7 +306,6 @@ same name in the package.  (See Example 2.)
 
 Each element's type can be scalar, array, hash, or class.
 
-
 =head2 The C<struct()> function
 
 The C<struct> function has three forms of parameter-list.
@@ -326,6 +344,15 @@ element name will be defined as an accessor method unless a
 method by that name is explicitly defined; in the latter case, a
 warning is issued if the warning flag (B<-w>) is set.
 
+=head2 Class Creation at Compile Time
+
+C<Class::Struct> can create your class at compile time.  The main reason
+for doing this is obvious, so your class acts like every other class in
+Perl.  Creating your class at compile time will make the order of events
+similar to using any other class ( or Perl module ).
+
+There is no significant speed gain between compile time and run time
+class creation, there is just a new, more standard order of events.
 
 =head2 Element Types and Accessor Methods
 
@@ -336,7 +363,7 @@ optionally preceded by a C<'*'>.
 The accessor method provided by C<struct> for an element depends
 on the declared type of the element.
 
-=over
+=over 4
 
 =item Scalar (C<'$'> or C<'*$'>)
 
@@ -355,7 +382,7 @@ The element is an array, initialized by default to C<()>.
 
 With no argument, the accessor returns a reference to the
 element's whole array (whether or not the element was
-specified as C<'@'> or C<'*@').
+specified as C<'@'> or C<'*@'>).
 
 With one or two arguments, the first argument is an index
 specifying one element of the array; the second argument, if
@@ -364,13 +391,17 @@ is C<'@'>, the accessor returns the array element value.  If the
 element type is C<'*@'>, a reference to the array element is
 returned.
 
+As a special case, when the accessor is called with an array reference
+as the sole argument, this causes an assignment of the whole array element.
+The object reference is returned.
+
 =item Hash (C<'%'> or C<'*%'>)
 
 The element is a hash, initialized by default to C<()>.
 
 With no argument, the accessor returns a reference to the
 element's whole hash (whether or not the element was
-specified as C<'%'> or C<'*%').
+specified as C<'%'> or C<'*%'>).
 
 With one or two arguments, the first argument is a key specifying
 one element of the hash; the second argument, if present, is
@@ -378,6 +409,10 @@ assigned to the hash element.  If the element type is C<'%'>, the
 accessor returns the hash element value.  If the element type is
 C<'*%'>, a reference to the hash element is returned.
 
+As a special case, when the accessor is called with a hash reference
+as the sole argument, this causes an assignment of the whole hash element.
+The object reference is returned.
+
 =item Class (C<'Class_Name'> or C<'*Class_Name'>)
 
 The element's value must be a reference blessed to the named
@@ -410,10 +445,9 @@ contents of that hash are passed to the element's own constructor.
 
 See Example 3 below for an example of initialization.
 
-
 =head1 EXAMPLES
 
-=over
+=over 4
 
 =item Example 1
 
@@ -444,7 +478,6 @@ type C<timeval>.
     $t->ru_stime->tv_secs(5);
     $t->ru_stime->tv_usecs(0);
 
-
 =item Example 2
 
 An accessor function can be redefined in order to provide
@@ -492,7 +525,6 @@ Note that the initializer for a nested struct is specified
 as an anonymous hash of initializers, which is passed on to the nested
 struct's constructor.
 
-
     use Class::Struct;
 
     struct Breed =>
@@ -520,9 +552,13 @@ struct's constructor.
     print "(which was a ", $cat->breed->name, ")\n";
     print "had two kittens: ", join(' and ', @{$cat->kittens}), "\n";
 
+=back
 
 =head1 Author and Modification History
 
+Modified by Casey West, 2000-11-08, v0.59.
+
+    Added the ability for compile time class creation.
 
 Modified by Damian Conway, 1999-03-05, v0.58.
 
@@ -540,7 +576,6 @@ Modified by Damian Conway, 1999-03-05, v0.58.
     Previously these were returned as a reference to a reference
     to the element.
 
-
 Renamed to C<Class::Struct> and modified by Jim Miner, 1997-04-02.
 
     members() function removed.
@@ -552,7 +587,6 @@ Renamed to C<Class::Struct> and modified by Jim Miner, 1997-04-02.
     Class name to struct() made optional.
     Diagnostic checks added.
 
-
 Originally C<Class::Template> by Dean Roehrich.
 
     # Template.pm   --- struct/member template builder