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 / Column.pm < prev    next >
Encoding:
Perl POD Document  |  2003-08-22  |  1.2 KB  |  69 lines
  1. package Class::DBI::Column;
  2.  
  3. =head1 NAME
  4.  
  5. Class::DBI::Column - A column in a table
  6.  
  7. =head1 SYNOPSIS
  8.  
  9.     my $column = Class::DBI::Column->new($name);
  10.  
  11.     my $name  = $column->name;
  12.  
  13.     my @groups = $column->groups;
  14.     my $pri_col = $colg->primary;
  15.  
  16.     if ($column->in_database) { ... }
  17.  
  18. =head1 DESCRIPTION
  19.  
  20. Each Class::DBI class maintains a list of its columns as class data.
  21. This provides an interface to those columns. You probably shouldn't be
  22. dealing with this directly.
  23.  
  24. =head1 METHODS
  25.  
  26. =cut
  27.  
  28. use strict;
  29. use base 'Class::Accessor';
  30.  
  31. __PACKAGE__->mk_accessors(qw/name accessor mutator/);
  32.  
  33. use overload
  34.     '""' => sub { shift->name_lc },
  35.     fallback => 1;
  36.  
  37. =head2 new
  38.  
  39.     my $column = Class::DBI::Column->new($column)
  40.  
  41. A new object for this column.
  42.  
  43. =cut
  44.  
  45. sub new {
  46.     my ($class, $name) = @_;
  47.     bless { name => $name, _groups => {} }, $class;
  48. }
  49.  
  50. sub name_lc { lc shift->name }
  51.  
  52. sub add_group {
  53.     my ($self, $group) = @_;
  54.     $self->{_groups}->{$group} = 1;
  55. }
  56.  
  57. sub groups {
  58.     my $self   = shift;
  59.     my %groups = %{ $self->{_groups} };
  60.     delete $groups{All} if keys %groups > 1;
  61.     return keys %groups;
  62. }
  63.  
  64. sub in_database {
  65.     return !scalar grep $_ eq "TEMP", shift->groups;
  66. }
  67.  
  68. 1;
  69.