File Coverage

blib/lib/CGI/Widget/Tabs.pm

Criterion	Covered	Total	%
statement	75	162	46.3
branch	21	64	32.8
condition	5	39	12.8
subroutine	15	21	71.4
pod	14	14	100.0
total	130	300	43.3

line

stmt

bran

cond

sub

pod

time

code

1

=head1 MODULE FOR SALE

2

3

I am not planning to make any changes to this module as I have not had to use

4

it in any projects of my own for the last couple of years. I am aware that

5

others are using it.

6

7

If anyone would like to to take over maintenance/development of this module

8

pleas get in touch.

9

10

=head1 NAME

11

12

CGI::Widget::Tabs - Create tab widgets in HTML

13

14

=head1 SYNOPSIS

15

16

use CGI::Widget::Tabs;

17

my $tab = CGI::Widget::Tabs->new;

18

19

use CGI;

20

my $cgi = CGI->new; # interface to the query params

21

22

$tab->headings(@titles); # e.g. qw/Drivers Cars Courses/

23

$tab->default("Courses"); # the default active tab

24

$tab->force_active("Courses"); # forceably make this the active tab

25

$tab->active; # the currently active tab

26

$tab->class("my_tab"); # the CSS class to use for markup

27

$tab->cgi_object($cgi); # the object holding the query params

28

$tab->cgi_param("t"); # the CGI query parameter to use

29

$tab->drop_params("ays"); # do NOT pass on "Are You Sure?" answers

30

$tab->wrap(4); # wrap after 4 headings...

31

$tab->indent(1); # ...and add indentation

32

$tab->render; # the resulting HTML code

33

$tab->display; # same as `print $tab->render'

34

35

36

$h = $tab->heading; # new OO heading for this tab

37

$h->text("TV Listings"); # heading text

38

$h->key("tv"); # key identifying this heading

39

$h->raw(1); # switch off HTML encoding

40

$h->url("whatsontonight.com"); # redirect URL for this heading

41

$h->class("red"); # this heading has it's own class

42

43

# See the EXAMPLE section for a complete example

44

45

=head1 DESCRIPTION

46

47

=head2 Introduction

48

49

CGI::Widget::Tabs lets you simulate tab widgets in HTML. You could benefit

50

from a tab widget if you want to serve only one page. Depending on the tab

51

selected you fetch and display the underlying data. There are three main

52

reasons for taking this approach:

53

54

1. For the end user not to be directed to YAL or YAP (yet another link / yet

55

another page), but keep it all together: The single point of entry paradigm.

56

57

2. As a consequence the end user deals with a more consistent and integrated

58

GUI. This will give a better "situational awareness" within the application.

59

60

3. For the Perl hacker to handle multiple related data sources within the

61

same script environment.

62

63

64

As an example the following tabs could be used on a web page for someone's

65

spotting hobby:

66

67

__________ __________ __________

68

/ Planes \ / Trains \ / Classics \

69

------------------------------------------------------

70

_________

71

/ Bikes \

72

------------------------

73

74

As you can see, the headings wrap at three and a small indentation is added

75

to the start of the next row. The nice thing about CGI::Widget::Tabs is that

76

the tabs know their internal state. So you can ask a tab for instance which

77

heading has been clicked by the user. This way you get instant feedback.

78

79

=head2 "Hey Gorgeous!"

80

81

Of course tabs are useless if you can't "see" them. Without proper make up

82

they print as ordinary text. So you really need to fancy them up with some

83

eye candy. The designed way is that you provide a CSS style sheet and have

84

CGI::Widget::Tabs use that. See the class() method for how to do this.

85

86

87

=head1 EXAMPLE

88

89

Before digging into the API and all accessor methods, this example will

90

illustrate how to implement the spotting page from above. So you have

91

something to start with. It will give you enough clues to get on the road

92

quickly. The following code is a simple but complete example. Copy it and run

93

it through the webservers CGI engine. (For a even more complete and useful

94

demo with multiple tabs, see the file tabs-demo.pl in the CGI::Widget::Tabs

95

installation directory.) To fully appreciate it, it would be best to run it

96

in a performance environment, like mod_perl or SpeedyCGI.

97

98

#! /usr/bin/perl -w

99

use CGI::Widget::Tabs;

use CGI;

print <

Content-Type: text/html;

EOT

my $cgi = CGI->new;

my $tab = CGI::Widget::Tabs->new;

$tab->cgi_object($cgi);

$tab->headings( qw/Planes Traines Classics Bikes/ );

$tab->wrap(3);

# $tab->wrap(1); # |uncomment to see the effect of

# $tab->indent(0); # |wrapping at 1 without indentation

$tab->default("Traines");

$tab->display;

print "
We now should run some intelligent code ";

print "to process ", $tab->active, "
";

print "";

=head1 PUBLIC INTERFACE

=cut

package CGI::Widget::Tabs;

# pragmata

2

75146

use strict;

2

4

2

84

2

11

use vars qw/$VERSION/;

2

3

2

89

# Standard Perl Library and CPAN modules

2

17

use Carp;

2

8

2

133

2

1681

use URI::Escape();

2

2953

2

61

2

2282

use HTML::Entities();

2

14525

2

111

# CGI::Widget::Tabs modules

2

1677

use CGI::Widget::Tabs::Heading;

2

13

2

3848

$VERSION = "1.14";

=head2 Public Class Interface

=head3 new

new()

Creates and returns a new CGI::Widget::Tabs object. new() does not take any

arguments.

=cut

sub new {

10

21910

my $proto = shift;

10

44

my $class = ref($proto) || $proto;

10

15

my $self = {};

10

28

bless ($self, $class);

10

25

$self->indent(1);

10

512

return $self;

}

=head2 Public Object Interface

=head3 active

active()

Returns a string indicating the current active tab heading. This is (in order of

precedence) the heading set by force_active(), the heading being clicked on, the

default heading, or the first in the list. The string value will either be the

heading key or the heading text, depending on if you chose to use keys. Example:

if ( $tab->active() eq "Trains" ) { # heading text only

if ( $tab->active() eq "-t" ) { # key value ISO heading text

=cut

sub active {

#

# Returns the active heading. In order of precendence:

# 1. A mandatory heading

# 2. The heading clicked by the user

# 3. The default heading

# 4. The first heading in the list

#

10

39

my $self = shift;

10

11

my $active;

# 1. Heading clicked

# 1. Mandatory heading

10

19

$active = $self->force_active();

10

21

return $active if defined $active;

# 2. Heading clicked

10

19

$active = $self->cgi_object->param($self->cgi_param);

10

200

return $active if defined $active;

# 3. Default

6

12

$active = $self->default;

6

39

return $active if defined $active;

# 4. First

3

8

my $h = ($self->headings)[0]; # headings are always OO objects

3

11

return $h->key || $h->text;

}

=head3 cgi_object

cgi_object(OBJECT)

Sets/returns the CGI or CGI::Minimal object. If the optional argument OBJECT is

given, the CGI object is set, otherwise it is returned. CGI::Widget::Tabs uses

this object internally to process the CGI query parameters. If you want you can

use some other CGI object handler. However such an object handler must provide a

param() method with corresponding behaviour as do CGI or CGI::Minimal. Note that

currently only CGI and CGI::Minimal have been tested. Example:

# set

my $cgi = CGI::Minimal->new;

$tab->cgi_object($cgi);

# get

my $cgi = $tab->cgi_object;

=cut

sub cgi_object {

#

# The cgi object to retrieve the parameters from.

# Could be a CGI object or a CGI::Minimal object.

#

20

50

my $self = shift;

20

23

my $cgi = shift;

20

37

if ( $cgi ) {

10

35

if ( ref $cgi ne "CGI" and ref $cgi ne "CGI::Minimal") {

0

0

carp "Warning: Expected CGI or CGI::Minimal object";

}

10

19

$self->{cgi_object} = $cgi;

}

20

45

return $self->{cgi_object};

}

=head3 cgi_param

cgi_param(STRING)

Sets/returns the CGI query parameter. This parameter identifies the tab in the

CGI query string (the funny part of the URL with the ? = & # characters). If

the optional argument STRING is given, the query parameter is set. Otherwise it

is returned. Usually you can leave this untouched. In that case the default

parameter "tab" is used. You will need to set this if you have more CGI query

parameters on the URL with "tab" already being taken. Another situation is if

you use multiple tab widgets on one page. They both would use "tab" by default

causing conflicts. Example:

# Lets paint a fruit tab and a vegetable tab

my $fruits_tab = CGI::Widget::Tabs->new;

my $vegies_tab = CGI::Widget::Tabs->new;

# this is our link with the outside world

my $cgi = CGI::Minimal->new;

$fruits_tab->cgi_object($cgi);

$vegies_tab->cgi_object($cgi);

# In the CGI params collection the first is

# identified by 'ft' and the second by 'vt'

$fruits_tab->cgi_param("ft");

$vegies_tab->cgi_param("vt");

=cut

sub cgi_param {

#

# CGI parameter specifing the tab. Defaults to "tab".

#

44

403

my $self = shift;

44

152

if ( @_ ) {

10

22

$self->{cgi_param} = shift;

}

44

429

return $self->{cgi_param} || "tab";

}

=head3 drop_params

drop_params(LIST)

Sets/retrieves the list of CGI parameters to be dropped from the parameter

list. If the optional argument LIST is given the list is set, otherwise it is

retrieved. Suppose you have clicked "Yes" to some "Are you sure?" question. You

certainly want that question to be asked every time, right? Especially if the

actions that go with it are destructive. If you did NOT specify the parameter

to be dropped, "Yes" would have been silently passed on to the parameter

list. That would effectively preset "Are you sure" with "Yes" causing disastrous

results. Examples:

$tab->drop_params("ays"); # drop the "Are you sure" param

=cut

sub drop_params {

#

# These parameters should not be passed on.

#

0

0

my $self = shift;

0

0

if ( @_ ) {

0

0

$self->{drop_params} = [@_];

}

0

0

return @{ $self->{drop_params} || [] };

0

0

}

=head3 class

class(STRING)

Sets/returns the name of the CSS class used for the tabs markup. If the optional

argument STRING is given the class is set, otherwise it is returned. If not

set, the widget will be based on the class "tab". In the accompanying style

sheet, there are five class elements you need to provide:

=over 4

=item 1. A table element for containment of the entire tab widget

=item 2. A td element for a normal tab

=item 3. A td element for the active tab

=item 4. A td element for the spacers

=item 5. A td element for the indentation (if needed)

=back

The class names of these elements are directly borrowed from the class()

method. The td elements for the active tab, the spacers and the indentations are

suffixed with "_actv", "_spc" and "_ind" respectively. For instance, if you'd

run

$tab->class("my_tab");

then the elements look like:

# the entire table ); ); \n"; # | row if it didn't just

# normal tab

# active tab

# spacer

# indentation

If you don't wrap headings, then ofcourse you won't need to specify the

indentation td's. By the way, the indentation will usually look most natural if

it has the same width as the spacers or a multiple thereof. Look at the example

in the EXAMPLE section to see how this all works out.

=cut

sub class {

#

# The CSS class for display of the tabs

# Defaults to 'tab'.

#

0

0

my $self = shift;

0

0

if ( @_ ) {

0

0

$self->{class} = shift;

}

0

0

return $self->{class} || "tab";

}

=head3 default

default(STRING)

Overrides which heading is the default. Normally CGI::Widget::Tabs will make the

first heading active. Use the default() method if you want to deviate from

this. The optional argument STRING must either be the heading key or the heading

text, depending on how you chose to initialize the headings. Example:

# Make the "Trains" heading the default active one.

$tab->default("Trains");

# ...or perhaps...

$tab->default("-t");

=cut

sub default {

#

# The default active heading

#

12

33

my $self = shift;

12

29

if ( @_ ) {

6

10

$self->{default} = shift;

}

12

23

return $self->{default}

}

=head3 display

display()

Renders the tab widget and prints the resulting HTML to the default output

handle (usually STDOUT). Example:

$tab->display; # this is the same as...

print $tab->render; # ...but saves a few keystrokes

See also the render() method.

=cut

sub display {

#

# save a few keystrokes

#

0

0

my $self = shift;

0

0

print $self->render;

}

=head3 force_active

force_active(STRING)

Forces the activation of a specific tab identified by it's heading text

or key. This is useful if you have an application which must show a

certain tab after doing someting. Or if you're paranoid and you've been

given a CGI query string which you don't trust. In both cases you can

make sure the tab of your preference is activated. Example:

$tab->force_active("Trains"); # heading text only

$tab->force_active("-t"); # key

$tab->force_active(undef); # forget all about it

=cut

sub force_active {

#

# Activates a heading. Takes heading text, key or undef.

#

10

13

my $self = shift;

10

22

if ( @_ ) {

0

0

$self->{force_active} = shift;

}

10

17

return $self->{force_active};

}

=head3 heading

heading()

Creates, appends and returns a new heading. The return value will always be an

OO heading object. Example:

my $h = $tab->heading();

In general you will use OO headings if the headings() method is not flexible

enough. For trivial applications the headings() method mostly suffices. Look at

section PROPERTIES OF OO HEADINGS for more information on OO headings.

=cut

sub heading {

#

# Create, add, and return a new heading object

#

24

65

my $self = shift;

24

79

my $h = CGI::Widget::Tabs::Heading->new();

24

48

push @{ $self->{headings} }, $h;

24

53

24

49

return $h;

}

=head3 headings

headings(LIST)

Sets/returns the tab headings. Without arguments the currently defined headings

are returned. If no headings are defined, the empty list is returned. Any

returned heading will always be an OO heading, regardless of if and how the

initializing LIST argument is used. Look at section PROPERTIES OF OO HEADINGS

for more info on how to deal with OO headings.

The optional LIST argument is a short-cut to the OO headings interface. The

elements of LIST can take various forms. Let's take a moment to take a close

look at the headings of a tab. Tab headings are the things that --from human

perspective-- identify a tab page. Observe the spotting example above. Here the

different tab pages are identified by the strings "Planes", "Trains", "Classics"

and "Bikes". They form the heading for each seperate tab. The LIST elements can

be used to preset these tab headings.

An element of LIST can be any one of:

=over 4

=item * a string. E.g.:

qw/Planes Trains Classics Bikes/

This is the simplest initializer. In the spotting example the four tabs headings

are easily created by feeding these words as a list to the headings()

method. And then you are almost done: the headings can be displayed and each

heading gets it's own self referencing URL.

=item * a key/value pair. E.g.:

( -p => "Planes",

-t => "Trains",

-c => "Classics,

-b => "Bikes" )

For trivial CGI::Widget::Tabs applications, the k/v pairs are the ones you will

probably use the most. They come in handy because you don't need to check the

value returned by active() against very long words. Even better, if you change

the tab headings (upper/lower case, typo's) but use the same keys you don't need

to change your code. So it is less error prone. As a pleasant side effect, the

URL's get to be significantly shorter. Do notice that the keys want to be

unique. Keys in a k/v list are not at all magical. You can choose any string you

like with the provision that they start with the '-' (hyphen) sign. The starting

'-' of a list entry is what triggers CGI::Widget::Tabs to decide this is a k/v

entry. Single or dual character strings tend to be the most convenient keys.

=item * a hash

This use of the headings() method will clutter up your code. The hash tries to

mimic and encapsulate all OO accessor methods. If think you need an initializer

hash, you probably want OO headings. Use it only if you must. If you can stick

with the strings or k/v pairs. That said, the hash keys are the named

equivalents of the OO heading properties. E.g.:

( { text => "Planes",

key => "p",

url => "www.aviation-mag.com",

class => "heavens_blue",

raw => 0 },

=back

You can mix these types in any way you like. The various types will be

translated on the fly to OO headings and then processed. Thus you can safely

say:

$tab->headings( "Plaines",

-t => "Traines",

{ text => "Classics",

key => "c",

... } )

Just as the hash initializer, this use does clutter up your code. The reason is

that different concepts of information are piled up on one big heep. You will

need to scrutinize the code to understand what it is going on. Although it is

supported you should refrain yourself from making use of these combinations.

As a summary, here are a three examples of the headings() method for the

spotting page.

# Example 1: Set the headings with a list of strings

my $tab = CGI::Widget::Tabs->new();

$tab->headings( qw/Planes Trains Classics Bikes/ );

# Example 2: Set the headings with a list of k/v pairs

my $tab = CGI::Widget::Tabs->new();

$tab->headings( -p => "Planes",

-t => "Trains",

-c => "Classics,

-b => "Bikes" );

# Example 3: Isolate the "Classics" heading

my $h = ($tab->headings)[2];

Note that these few statements provide almost enough logic to generate the HTML

for the tab widget!

=cut

sub headings {

# Takes optional user defined simple headings as arguments,

# which will be transformed into OO headings. E.g.:

# ( "Software", -hw => "Hardware", { text => "Wetware", key => "ww" } )

#

9

534

my $self = shift;

9

24

if ( @_ ) { # any arguments?

6

8

my $h; # OO heading

my $ht; # _heading _text

6

25

HEADING: while ( my $arg = shift @_ ) {

14

30

$h = $self->heading(); # add a new heading

14

31

if ( ! ref $arg ) { # Not a hash initializer

# -- k/v pair

14

40

( $arg =~ /^-/ ) && do {

7

21

$h->key($arg);

7

19

$h->text(shift @_);

7

21

next HEADING;

};

# -- text only

7

25

$h->text($arg);

7

23

next HEADING;

}

# -- hash initializer

0

0

( ref($arg) eq "HASH" ) && do {

0

0

if ( ! $arg->{text} ) {

0

0

croak "Hash initializer is missing mandatory text element";

}

0

0

$h->text($arg->{text});

0

0

if ( exists( $arg->{key} ) && $arg->{key} ) { $h->key( $arg->{key} ) }

0

0

0

0

if ( exists( $arg->{url} ) && $arg->{url} ) { $h->url( $arg->{url} ) }

0

0

0

0

if ( exists( $arg->{raw} ) && $arg->{raw} ) { $h->raw( $arg->{raw} ) }

0

0

0

0

if ( exists( $arg->{class} ) && $arg->{class} ) { $h->class( $arg->{class} ) }

0

0

0

0

next HEADING;

};

0

0

croak "Unsupported heading type";

0

0

next;

}

}

9

11

return @{ $self->{headings} || [] };

9

33

}

=head3 indent

indent(BOOLEAN)

Sets/returns the indentation setting. Without arguments the current setting is

returned. indent() specifies if indentation should be added to the next row when

the headings get wrapped. indent() is a toggle. By default indent() is set to

TRUE. You must explicitely switch it off for the desired effect. The optional

argument BOOLEAN can be any argument evaluating to a logical value.

The purpose of swithing off indentation is to simulate a vertical menu. In the

spotting example, running

$tab->wrap(1);

$tab->indent(0);

would result in something like:

__________

| Planes |

--------------

__________

| Trains |

--------------

__________

| Classics |

--------------

__________

| Bikes |

--------------

You probably need to tweak your style sheet to have it look nicely.

=cut

sub indent {

#

# Indentation after wrapping to next line?

#

10

13

my $self = shift;

10

12

my $arg = shift;

10

21

if ( defined $arg ) {

10

34

$self->{indent} = $arg ? 1 : 0;

}

10

20

return $self->{indent};

}

=head3 render

render()

Renders the tab widget and returns the resulting HTML code. This is useful if

you need to print the tab to a different file handle. Another use is if you want

to manipulate the HTML. For instance to insert session id's or the like. See

the class() method and the EXAMPLE section somewhere else in this document to

see how you can influence the markup of the tab widget. Example:

my $html = $tab->render;

print HTML $html; # there's a session id filter behind HTML

=cut

sub render {

#

# Process the lot and display it.

#

0

my $self = shift;

0

my $cgi = $self->cgi_object;

0

my @headings = $self->headings;

0

my $class = $self->class;

0

my $cgi_param = $self->cgi_param;

0

my $active = $self->active;

0

my $wrap = $self->wrap;

0

my $indent = $self->indent;

0

my $spacer = qq(

0

my $indentation = qq(

0

my @html;

my $url;

0

my $query_string_min_min; # the query string minus the varying tab

# -- reproduce the CGI query string EXCEPT the varying tab

0

my @param_list = grep( $_ ne $cgi_param,$cgi->param() );

# - From this list remove the wannabe-dropped

0

my %drop_params = ();

0

foreach ( $self->drop_params() ) { $drop_params{$_} = 1 };

0

0

@param_list = grep (!exists $drop_params{$_}, @param_list);

0

if ( @param_list ) {

0

$query_string_min_min = join "&", map ( "$_=".URI::Escape::uri_escape($cgi->param($_)||"") , @param_list );

0

$query_string_min_min .= "&";

} else {

0

$query_string_min_min = "";

}

0

if ( @headings ) {

0

@html = ();

0

push @html, "\n";

0

my $heading_nr = 1; # we're about to render the first heading...

0

my $row_nr = 1; # ...of the first row

0

my $param_value;

my $h;

0

my $url;

0

foreach $h ( @headings ) {

0

if ( $heading_nr == 1 ) { # first one in the row?

0

push @html, qq(\n\n); $spacer\n"; \n"; # | yes, end this row

771	0	0	0				if ( $indent && $row_nr > 1 ) { # = print indents if
772	0						push @html, ( $indentation x ($row_nr - 1)); # = necessary
773							} # =
774	0						push @html, "$spacer\n"; # each row starts with a spacer
775							}
776
777							# -- actual headings
778	0		0				$param_value = $h->key \|\| $h->text;
779	0	0					if ( defined $h->class() ) { # heading has local class?
780	0						push @html, qq(	';
781							} else {
782	0						push @html, qq(	783	0	0					push @html, qq(_actv) if $param_value eq $active;
784	0						push @html, qq(">);
785							}
786
787							# -- user defined URL or default self ref. URL?
788	0		0				my $url = $h->url \|\| ( "?$query_string_min_min$cgi_param=".URI::Escape::uri_escape($param_value) );
789	0						push @html, _link( $h->text , $url );
790	0						push @html, "
791
792							# -- end of row
793	0	0	0				if ( $wrap && ( $heading_nr == $wrap ) ) { # last one on this row?
794	0						push @html, "
795	0						push @html, "

\n"; # |

0

$heading_nr = 0;

0

$row_nr++;

}

0

$heading_nr++;

}

# --- all headings printed

0

if ( $heading_nr > 1 ) { # | We need to end this

0

push @html, "

0

push @html, "

\n"; # | get wrapped.

}

}

0

push @html, "\n";

0

return join("", @html);

}

=head3 wrap

wrap(NUMBER)

Sets or returns the wrap setting. Without arguments the current wrap setting is

returned. If the argument NUMBER is given the headings will wrap to the next row

after NUMBER headings. By default headings are not wrapped.

=cut

sub wrap {

#

# wrap to next row after this num of headings

#

0

my $self = shift;

0

if ( @_ ) {

0

$self->{wrap} = shift;

}

0

return $self->{wrap};

}

=head1 INTERNALS

=head2 Private Class Methods

=head3 _link

link($text, $href)

Returns a HTML 'a' tag pair linking to $href with text $text

=cut

sub _link {

#

# Create a link for some text to a href

# Expects = (,) pair.

#

0

return qq($_[0]);

}

1;

__END__