home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Collection.pm < prev    next >
Encoding:
Perl POD Document  |  2002-10-22  |  1.9 KB  |  88 lines
  1.  
  2. package Apache::ASP::Collection;
  3.  
  4. use Apache::ASP::CollectionItem;
  5. use strict;
  6.  
  7. sub Contents { 
  8.     my($self, $key) = @_;
  9.     
  10.     if(defined $key) {
  11.     $self->Item($key);
  12.     } else {
  13.     $self;
  14.     }
  15. }
  16.  
  17. sub Item {
  18.     my($self, $key, $value) = @_;
  19.     my @rv;
  20.     my $item_config = $main::Server->Config('CollectionItem');
  21.  
  22.     if(defined $value) {
  23.     if(ref($self->{$key}) and $self->{$key} =~ /HASH/) {
  24.         # multi leveled collection go two levels down
  25.         $rv[0] = $self->{$key}{$value};
  26.     } else {
  27.         return $self->{$key} = $value;
  28.     }
  29.     } elsif(defined $key) {
  30.     my $value = $self->{$key};    
  31.     if (defined $value) {
  32.         if(wantarray || $item_config) {
  33.         @rv = (ref($value) =~ /ARRAY/o) ? @{$value} : ($value);
  34.         } else {
  35.         @rv = (ref($value) =~ /ARRAY/o) ? ($value->[0]) : ($value);
  36.         }
  37.     } else {
  38.         $rv[0] = $value;
  39.     }
  40.     } else {
  41.     # returns hash to self by default, so compat with 
  42.     # $Request->Form() & such null collection calls.
  43.     return $self;
  44.     }
  45.  
  46.     # coming from the collections we need this like
  47.     # $Request->QueryString('foo')->Item() syntax, but is incompatible
  48.     # with $Request->QueryString('foo') syntax
  49.     if ($item_config) {
  50.     $rv[0] = Apache::ASP::CollectionItem->new(\@rv);
  51.     }
  52.  
  53.     wantarray ? @rv : $rv[0];
  54. }
  55.  
  56. sub Count {
  57.     my $self = shift;
  58.     scalar(keys %$self);
  59. }
  60.  
  61. sub Key {
  62.     my($self, $index) = @_;
  63.     my @keys = sort(keys %$self);
  64.     $keys[$index-1];
  65. }
  66.  
  67. sub SetProperty {
  68.     my($self, $property, $key, $value) = @_;
  69.     if($property =~ /property/io) {
  70.     # do this to avoid recursion
  71.     die("can't get the property $property for $self");
  72.     } else {
  73.     $self->$property($key, $value);
  74.     }
  75. }    
  76.  
  77. sub GetProperty {
  78.     my($self, $property, $key) = @_;
  79.     if($property =~ /property/io) {
  80.     # do this to avoid recursion
  81.     die("can't get the property $property for $self");
  82.     } else {
  83.     $self->$property($key);
  84.     }
  85. }    
  86.     
  87. 1;
  88.