view release on metacpan or  search on metacpan

lib/BingoX/Cobalt.pm  view on Meta::CPAN

							_app		=> $app,
							_db_obj		=> $db_obj,
							_dbh		=> $dbh
						}, $rclass);
		}
	}, 'BingoX::Cobalt::Stream');
} # END of stream_related


=item list_related( $rel_display_class [, \@fields] [, \@sort] [, $unary_rev_flag ] )

Returns an array ref of related display objects from the $rel_display_class class.

=cut
sub list_related {
	my $self	= shift;
	return undef unless ref($self && $self->db_obj);
	my $stream	= $self->stream_related( @_ );
	return undef unless (ref $stream);
	my @list;
	push(@list, $a) while ($a = $stream->());
	return \@list;
} # END of list_related


=back

=head2 OBJECT METHODS

=over 4

=item C<db_obj> (  )

Returns the Data object for the Display Class that it was called 
from, with the constraint being: map $q->param( $_ ) @{ $data_class->primary_keys }

=cut
sub db_obj {
	my $self = shift;
	return undef unless (ref $self);						# needs to be called as an object method
	return $self->{'_db_obj'} if (ref $self->{'_db_obj'});	# return cached object
	my $q 		= $self->cgi;
	my $params 	= { };
	foreach (@{ $self->data_class->primary_keys }) {
		return undef unless (defined $q->param( $_ ));
		$params->{ $_ } = $q->param( $_ );
	}

	return undef unless (keys %$params);					# primary key needs to exist
	my $arrayref = $self->data_class->list_obj($self->dbh, $params);
	$self->{'_db_obj'} = $arrayref->[0] if (ref $arrayref);
	$self->{'_db_obj'};
} # END of db_obj


########################  Display Methods ########################


=item C<hour_menu> ( $name [, $default ] [, $24hr ] )

Returns a Popup Menu with Hours.

=cut
sub hour_menu {
	my $self	= shift;
	my $name	= shift;
	my $default	= shift || undef;
	my $hr24	= shift || undef;
	my $date	= ref($default) ? $default : BingoX::Time->new;
	my $values;

	if ($hr24) {
		$default	= $date->hour;
		$values		= $date->hours24;
	} else {
		$values 	= $date->hours;
		if ($date->hour > 0 && $date->hour <= 12) {
			$default = $date->hour;
		} elsif ($date->hour == 0) {
			$default = '12';
		} else {
			$default = $date->hour - 12;
		}
	}

	return $self->cgi->popup_menu(	-NAME		=> $name,
									-VALUES		=> $values,
									-DEFAULT	=> sprintf("%02d", $default),
									-OVERRIDE	=> 1);
} # END of sub hour_menu


=item C<min_menu> ( $name [, $default ] )

Returns a Popup Menu with Minutes.

=cut
sub min_menu {
	my $self	= shift;
	my $name	= shift;
	my $default	= shift || undef;
	my $date	= ref($default) ? $default : BingoX::Time->new;

	return $self->cgi->popup_menu(	-NAME		=> $name,
									-VALUES		=> $date->minutes,
									-DEFAULT	=> sprintf("%02d", $date->min),
									-OVERRIDE	=> 1);
} # END of sub min_menu


=item C<am_pm_menu> ( $name [, $default ] )

Returns a Popup Menu with AM/PM menus.

=cut
sub am_pm_menu {
	my $self	= shift;
	my $name	= shift;
	my $default	= shift || undef;
	my $date	= ref($default) ? $default : BingoX::Time->new;

	if ($date->hour >= 0 && $date->hour < 12) {
		$default = 'AM';
	} else {
		$default = 'PM';
	}
	return $self->cgi->popup_menu(	-NAME 		=> $name,
									-VALUES 	=> [ 'AM', 'PM' ],
									-DEFAULT 	=> $default || '',
									-OVERRIDE 	=> 1);
} # END of sub am_pm_menu


=item C<day_menu> ( $name [, $default ] )

Returns a Popup Menu with the Days of the Month.

=cut
sub day_menu {
	my $self	= shift;
	my $name	= shift;
	my $default	= shift || undef;
	my $date	= ref($default) ? $default : BingoX::Time->new;

	return $self->cgi->popup_menu(	-NAME		=> $name,
									-VALUES		=> [ 1 .. 31 ],
									-DEFAULT	=> $date->mday,
									-OVERRIDE	=> 1);
} # END of sub day_menu


=item C<month_menu> ( $name [, $default ] )

Returns a Popup Menu with the Months of the Year.

=cut
sub month_menu {
	my $self	= shift;
	my $name	= shift;
	my $default	= shift || undef;
	my $date	= ref($default) ? $default : BingoX::Time->new;

	return $self->cgi->popup_menu(	-NAME		=> $name,
									-VALUES		=> [ 1 .. 12 ],
									-LABELS		=> $date->months,
									-DEFAULT	=> $date->mon,
									-OVERRIDE	=> 1);
} # END of sub month_menu


=item C<year_menu> ( $name [, $default ] )

Returns a Popup Menu with a list of Years up to 20 years from now.

=cut
sub year_menu {
	my $self	= shift;
	my $name	= shift;
	my $default	= shift || undef;
	my $date	= ref($default) ? $default : BingoX::Time->new;
	my $start_year = $date->year;

	return $self->cgi->popup_menu(	-NAME 		=> $name,
									-VALUES 	=> [ ($start_year - 20) .. ($start_year + 20) ],
									-DEFAULT 	=> $date->year,
									-OVERRIDE 	=> 1);
} # END of sub year_menu


=item C<errors_list> (  )

Returns list of errors in list format.

=cut
sub errors_list {
	my $self	= shift;
	my $list	= shift;
	my $q		= $self->cgi;
	my $errs	= $self->{'_errors'};
	return '' unless (keys %$errs);
	my $html = '<B>' . $self->conf->error_msg . "</B>\n" unless ($errs->{'success'});

	if ($list) {
		$html .= "<" . $list . ">\n";
		foreach (sort keys %$errs) { $html .= "<LI>" . $errs->{$_} . "\n" }
		$html .= "</" . $list . ">\n";
	} else {
		foreach (keys %$errs) { $html .= $errs->{$_} . "\n" }
	}

	return $html;
} # END of errors_list


########################  Form Methods ########################

=item C<alink> ( \%params, $text | \@text )

Returns a hyper link with the params passed to it, -HREF, -JAVASCRIPT.

=cut
sub alink {
	my $self = shift;
	return $self->cgi->a(@_);
} # END of sub alink


=item C<submit> ( $name, %params )

Returns a Submit Button with the params passed to it, -NAME, -VALUE, -JAVASCRIPT.

=cut
sub submit {
	my $self = shift;
	my $name = shift;
	return $self->cgi->submit(-NAME => $name, @_);
} # END of sub submit


=item C<image_button> ( $name, %params )

Returns a hyper link with the params passed to it, -HREF, -SRC, 
-BORDER, -ALT, -JAVASCRIPT.

=cut
sub image_button {
	my $self = shift;
	my $name = shift;
	return $self->cgi->image_button(-NAME => $name, @_);
} # END of sub image_button


=item C<textfield> ( $name, %params )

Returns a Text Field with the params passed to it, -VALUE, -SIZE, 
-OVERRIDE.

=cut
sub textfield {
	my $self = shift;
	my $name = shift;
	return $self->cgi->textfield(-NAME => $name, -DEFAULT => ($self->_get_default($name) || ''), @_);
} # END of sub textfield


=item C<hidden> ( $name, %params )

Returns a Hidden Field with the params passed to it, -VALUE.

=cut
sub hidden {
	my $self = shift;
	my $name = shift;
	return $self->cgi->hidden(-NAME => $name, @_);
} # END of sub hidden


=item C<popup_menu> ( $name, %params )

Returns a Popup Menu with the params passed to it, -VALUES, -LABELS, 
-OVERRIDE.

=cut
sub popup_menu {
	my $self = shift;
	my $name = shift;
	return $self->cgi->popup_menu(-NAME => $name, -DEFAULT => ($self->_get_default($name) || ''), @_);
} # END of sub popup_menu


=item C<checkbox> ( $name, %params )

Returns a Checkbox with the params passed to it, -VALUE, -LABEL, 
-OVERRIDE.

=cut
sub checkbox {
	my $self = shift;
	my $name = shift;
	return $self->cgi->checkbox(-NAME => $name, -DEFAULT => ($self->_get_default($name) || ''), @_);
} # END of sub checkbox


=item C<checkbox_group> ( $name, %params )

Returns a Checkbox Button Group with the params passed to it, 
-VALUES, -LABELS, OVERRIDE.

=cut
sub checkbox_group {
	my $self = shift;
	my $name = shift;
	return $self->cgi->checkbox_group(-NAME => $name, -DEFAULT => ($self->_get_default($name) || ''), @_);
} # END of sub checkbox_group


=item C<radio_group> ( $name, %params )

Returns a Radio Button Group with the params passed to it, 
-NAME, -VALUES, -LABELS, -DEFAULT, -OVERRIDE.

=cut
sub radio_group {
	my $self = shift;
	my $name = shift;
	return $self->cgi->radio_group(-NAME => $name, -DEFAULT => ($self->_get_default($name) || ''), @_);
} # END of sub radio_group


=item C<get_default> (  )

Gets the default value for the field name requested.

=cut
sub get_default {
	my $self = shift;
	return $self->_get_default(@_);
} # END of get_default