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 / ColumnGrouper.pm < prev    next >
Encoding:
Perl POD Document  |  2003-12-31  |  3.4 KB  |  178 lines
  1. package Class::DBI::ColumnGrouper;
  2.  
  3. =head1 NAME
  4.  
  5. Class::DBI::ColumnGrouper - Columns and Column Groups
  6.  
  7. =head1 SYNOPSIS
  8.  
  9.     my $colg = Class::DBI::ColumnGrouper->new;
  10.        $colg->add_group(People => qw/star director producer/);
  11.  
  12.     my @cols = $colg->group_cols($group);
  13.  
  14.     my @all            = $colg->all_columns;
  15.     my @pri_col        = $colg->primary;
  16.     my @essential_cols = $colg->essential;
  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 that. You probably don't want to be dealing
  22. with this directly.
  23.  
  24. =head1 METHODS
  25.  
  26. =cut
  27.  
  28. use strict;
  29.  
  30. use Carp;
  31. use Storable 'dclone';
  32. use Class::DBI::Column;
  33.  
  34. sub unique {
  35.     my %seen;
  36.     map { $seen{$_}++ ? () : $_ } @_;
  37. }
  38.  
  39. =head2 new
  40.  
  41.     my $colg = Class::DBI::ColumnGrouper->new;
  42.  
  43. A new blank ColumnnGrouper object.
  44.  
  45. =cut
  46.  
  47. sub new {
  48.     my $class = shift;
  49.     bless {
  50.         _groups => {},
  51.         _cols   => {},
  52.     }, $class;
  53. }
  54.  
  55. sub clone {
  56.     my ($class, $prev) = @_;
  57.     return dclone $prev;
  58. }
  59.  
  60. =head2 add_group
  61.  
  62.     $colg->add_group(People => qw/star director producer/);
  63.  
  64. This adds a list of columns as a column group.
  65.  
  66. =cut
  67.  
  68. =head2 column 
  69.  
  70.     my Class::DBI::Column $col = $cols->column($name);
  71.  
  72. Return a Column object for the given column name.
  73.  
  74. =cut
  75.  
  76. sub add_column {
  77.     my ($self, $name) = @_;
  78.     return $name if ref $name;
  79.     $self->{_allcol}->{ lc $name } ||= Class::DBI::Column->new($name);
  80. }
  81.  
  82. sub find_column {
  83.     my ($self, $name) = @_;
  84.     return $name if ref $name;
  85.     return unless $self->{_allcol}->{ lc $name };
  86. }
  87.  
  88. sub add_group {
  89.     my ($self, $group, @names) = @_;
  90.     $self->add_group(Primary => $names[0])
  91.         if ($group eq "All" or $group eq "Essential")
  92.         and not $self->group_cols('Primary');
  93.     $self->add_group(Essential => @names)
  94.         if $group eq "All"
  95.         and !$self->essential;
  96.     @names = unique($self->primary, @names) if $group eq "Essential";
  97.  
  98.     my @cols = map $self->add_column($_), @names;
  99.     $_->add_group($group) foreach @cols;
  100.     $self->{_groups}->{$group} = \@cols;
  101.     return $self;
  102. }
  103.  
  104. =head2 group_cols
  105.  
  106.     my @colg = $cols->group_cols($group);
  107.  
  108. This returns a list of all columns which are in the given group.
  109.  
  110. =cut
  111.  
  112. sub group_cols {
  113.     my ($self, $group) = @_;
  114.     return $self->all_columns if $group eq "All";
  115.     @{ $self->{_groups}->{$group} || [] };
  116. }
  117.  
  118. sub groups_for {
  119.     my ($self, @cols) = @_;
  120.     return uniq(map $_->groups, @cols);
  121. }
  122.  
  123. sub columns_in {
  124.     my ($self, @groups) = @_;
  125.     return uniq(map $self->group_cols($_), @groups);
  126. }
  127.  
  128. sub uniq {
  129.     my %tmp;
  130.     return grep !$tmp{$_}++, @_;
  131. }
  132.  
  133. =head2 all_columns
  134.  
  135.     my @all = $colg->all_columns;
  136.  
  137. This returns a list of all the real columns.
  138.  
  139. =head2 primary
  140.  
  141.     my $pri_col = $colg->primary;
  142.  
  143. This returns a list of the columns in the Primary group.
  144.  
  145. =head2 essential
  146.  
  147.     my @essential_cols = $colg->essential;
  148.  
  149. This returns a list of the columns in the Essential group.
  150.  
  151. =cut
  152.  
  153. sub all_columns {
  154.     my $self = shift;
  155.     return grep $_->in_database, values %{ $self->{_allcol} };
  156. }
  157.  
  158. sub primary {
  159.     my @cols = shift->group_cols('Primary');
  160.     if (!wantarray && @cols > 1) {
  161.         local ($Carp::CarpLevel) = 1;
  162.         confess(
  163.             "Multiple columns in Primary group (@cols) but primary called in scalar context"
  164.         );
  165.         return $cols[0];
  166.     }
  167.     return @cols;
  168. }
  169.  
  170. sub essential {
  171.     my $self = shift;
  172.     my @cols = $self->group_cols('Essential');
  173.     @cols = $self->primary unless @cols;
  174.     return @cols;
  175. }
  176.  
  177. 1;
  178.