view release on metacpan or  search on metacpan

NavBarDD.pm  view on Meta::CPAN

    color: #006633; 
    background-color: #FFFFFF;
}

td.vassal-normal {
    height: 4ex; 
    font-family: helvetica, arial; 
    font-size: 7pt; 
    color: #006633; 
    background-color: #FFFFCC; 
}

a.master {
    text-decoration: none;
    color: #FFFFFF;
}

a.vassal {
    text-decoration: none;
    color: #006633;
}

</style>
EOF

# if $bottom the bar is displayed both on the top and on the bottom
# of the page.
my $bottom = 0;

# $depth is the vassal bar's depth down the document hierarchy.
my $depth = 2;

sub handler($$) {
    my ($self, $r) = @_;

    my $bar = $self->read_configuration($r) || return DECLINED;    
    $r->content_type eq 'text/html' || return DECLINED;
    my $fh = Apache::File->new($r->filename) || return DECLINED;

    # the following handle caching; they stand in the way when
    # making changes to the code, so use them wisely

    # $r->update_mtime($bar->modified);
    # $r->set_last_modified;
    # my $rc = $r->meets_conditions;
    # return $rc unless $rc == OK;

    $r->send_http_header;
    return OK if $r->header_only;

    my $before = $self->before;
    my $style = $self->style;
    my $master_table_atts = $self->master_table_atts;
    my $vassal_table_atts = $self->vassal_table_atts;
    my $master_padding = $self->master_padding;
    my $vassal_padding = $self->vassal_padding; 
    my $after = $self->after;

    my $navbar = $self->make_bar($r, $bar);

    local $/ = "";
    while (<$fh>) {
      s:(</HEAD>):$style$1:oi;
      s:(<BODY.*?>):$1$before$navbar$after:osi;
      s:(</BODY.*?>):$navbar$1:osi if $self->bottom;
    } continue {
	$r->print($_);
    }

    return OK;
}

###############################################################################
# constructor                                                                 #
# it constructs the object; N.B.: the object contains the bar, which is       #
# constructed separately                                                      #
###############################################################################

sub new {
    my $class = shift;

    my $self = {
	style => $style,
	master_table_atts => $master_table_atts,
	vassal_table_atts => $vassal_table_atts,
	master_padding => $master_padding,
	vassal_padding => $vassal_padding,
	bottom => $bottom,
	depth => $depth,
	@_, # override previous attributes
    };
    return bless $self, $class;
}

###############################################################################
# accessor/modifier methods                                                   #
###############################################################################

sub style {
    my $self = shift;
    if (@_) { $self->{style} = shift; }
    return $self->{style};
}

sub master_table_atts {
    my $self = shift;
    if (@_) { $self->{master_table_atts} = shift; }
    return $self->{master_table_atts};
}

sub vassal_table_atts {
    my $self = shift;
    if (@_) { $self->{vassal_table_atts} = shift; }
    return $self->{vassal_table_atts};
}

sub master_padding {
    my $self = shift;
    if (@_) { $self->{master_padding} = shift; }
    return $self->{master_padding};
}