#!/usr/bin/perl
#-------------------------------------------------------------------------------
# PROJECT: Oekosoft XML menu generator
# MODULE: os_menu.pl
# VERSION: 1.0.1
# GOAL: Dynamic menu with different styles (according defintion in XML)
# AUTHOR: Walter Stucki, Oekosoft, CH-8444 Henggart
# DATE: 13.04.2005
#-------------------------------------------------------------------------------
# COPYRIGHT NOTICE
# Copyright (C) 2004 Oekosoft, All Rights reserved.
#
# Usage and selling of this program without prior written consent is
# expressly forbidden. In other words, please ask first before you try and
# make money with our program.
#
# Obtain permission before redistributing this software over the internet or
# any other medium. In all cases copyright and header must remain intact.
#-------------------------------------------------------------------------------
use strict;
use CGI;
use CGI::Cookie;
use XML::Smart;
my $WD = "with='16px' height='22px' border='0'";
my $MAXLEVEL = 8;
my $cgi = new CGI;
my $config = $cgi->param ('q_path')?
$cgi->param ('q_path').'/os_menu.xml' :
'os_menu.xml';
my $xml = XML::Smart->new ($config , 'XML::Smart::Parser') ;
$xml = $xml->{config};
my $top = $xml->{setup}->{'top-target'} ? $xml->{setup}->{'top-target'} : "_top";
my ($openmenu_ref, $closedmenu_ref, $menuentry_ref);
my %color = (
closed => '#003366',
entry => '#6699cc', ## '#b6d8e0', ### '#6699cc',
open => '#003366',
);
my %color = (
closed1 => $xml->{setup}->{color}->{closed1},
closed2 => $xml->{setup}->{color}->{closed2},
entry1 => $xml->{setup}->{color}->{entry1},
entry2 => $xml->{setup}->{color}->{entry2},
open1 => $xml->{setup}->{color}->{open1},
open2 => $xml->{setup}->{color}->{open2},
shade => $xml->{setup}->{color}->{shade},
);
my $float = $xml->{setup}->{'doctype'} eq 'STRICT' ? "style='float:left'" : "";
main ();
exit 0;
sub main {
my $width = $cgi->param ('m_width');
$width = $xml->{menu}->{width} unless $width;
$width = 140 unless $width;
my $processor = $cgi->param ('m_processor');
$processor = $xml->{setup}->{processor} unless $processor;
my $i;
if ($cgi->param ('q_command') eq 'login') {
login ($cgi, $xml->{menu});
print "Content-type: text/html\n\nSorry, try again.";
exit (0);
}
if ($cgi->param ('q_command') eq 'sitemap') {
print "Content-type: text/html\n\n";
sitemap ($xml->{menu}, 1);
exit (0);
}
if ($cgi->param ('m_frame')) {
dyna_frame ($xml->{menu}, $cgi->param ('m_frame'), $width);
}
header ($xml->{setup});
print " \n";
if ($processor =~ /explorer/) {
print " \n";
for ($i=0; $i < $MAXLEVEL; $i++) {
print " | \n";
}
print " \n";
$openmenu_ref = \&explorer_openmenu;
$closedmenu_ref = \&explorer_closedmenu;
$menuentry_ref = \&explorer_entry;
traverse ($cgi, $xml->{menu}, 0);
}
elsif ($processor =~ /tablebutton/) {
$openmenu_ref = \&tablebutton_openmenu;
$closedmenu_ref = \&tablebutton_closedmenu;
$menuentry_ref = \&tablebutton_entry;
traverse ($cgi, $xml->{menu}, 0);
}
elsif ($processor =~ /arrowtable/) {
$openmenu_ref = \&arrowtable_openmenu;
$closedmenu_ref = \&arrowtable_closedmenu;
$menuentry_ref = \&arrowtable_entry;
traverse ($cgi, $xml->{menu}, 0);
}
else {
die "Unimplemted style\n";
}
print " \n";
footer ($xml->{setup});
}
sub header {
my ($setup) = @_;
print "Content-type: text/html\n\n" .
(
$setup->{doctype} eq 'STRICT' ?
"\n" :
"\n"
) .
"\n" .
"\n" .
" XML Menu\n" .
" \n" .
" \n" .
" $setup->{headertags}\n" .
"\n" .
"{bodytags}>\n";
print $setup->{header} . "\n" if $setup->{header};
}
sub footer {
my ($setup) = @_;
print $setup->{footer} . "\n" if $setup->{footer};
print "\n\n\n";
}
#--------------------------------------------------------------------------------
# generate dynamically a frame page according the defined template
#
sub dyna_frame {
my ($item, $id, $width) = @_;
my $url = $ENV{REQUEST_URI};
my ($link, $frame, @submenus, $submenu);
if ($id eq $item->{id}) {
$url =~ s/m_frame=$id/m_$id=1/;
# read template file
open (IF, "<".$xml->{setup}->{'frame-template'}) or die "Frame template: $!";
while ( ) {
$frame .= $_;
}
close IF;
# encode &
$link = $item->{link};
$url =~ s/&/\&/g;
$link =~ s/&/\&/g;
# replace dynamic tags
$frame =~ s/\$MENU/$url/;
$frame =~ s/\$PAGE/$link/g;
$frame =~ s/\$WIDTH/$width/g;
# show the frame page
print qq|Content-type: text/html\n\n$frame|;
exit 0;
}
else {
# brows the submenus
@submenus = @{$item->{item}};
@submenus = () unless $submenus[0]->{name};
foreach $submenu (@submenus) {
dyna_frame ($submenu, $id, $width);
}
}
}
#--------------------------------------------------------------------------------
# check if a menu is private and if yes if the user is authorized
#
sub authorized {
my ($menu) = @_;
my $state = 0;
my (@users, $ue, $cookie, %cookies);
@users = @{$menu->{user}};
if ($#users == -1 || !$users[0]) {
$state = 1;
}
else {
$cookie = $xml->{setup}->{cookie}." (".$menu->{id}.")";
%cookies = fetch CGI::Cookie;
if ($cookies{$cookie}) {
foreach $ue (@users) {
$state = 1 if $cookies{$cookie}->value eq $ue->{name};
}
}
}
return $state;
}
#--------------------------------------------------------------------------------
# test user name and password and if correct set the according cookie
#
sub login {
my ($cgi, $menu) = @_;
my ($cookie, $user, $pwd, $id, $men, $ue);
$id = $cgi->param ('q_id');
if ($id eq $menu->{id}) {
$user = $cgi->param ('q_user');
$pwd = $cgi->param ('q_password');
foreach $ue (@{$menu->{user}}) {
if ($user eq $ue->{name} && $pwd eq $ue->{password}) {
$cookie = new CGI::Cookie (
-name => $xml->{setup}->{cookie}." (".$menu->{id}.")",
-path => '/',
-value => $user,
-expires => '+3M'
);
print $cgi->header ('text/html', cookie => $cookie);
print "Logged in as $user.\n";
exit 0;
}
}
print "Content-type: text/html\n\n";
print "Sorry, try again.";
exit (0);
}
else {
foreach $men (@{$menu->{item}}) {
login ($cgi, $men) if $men->{name};
}
}
}
sub lastdisplayeditem {
my ($n, @items) = @_;
my ($i);
return 1 if $n == $#items;
for ($i = $n+1; $i <= $#items; $i++) {
if (authorized ($items[$i]) && $items[$i]->{restrict} ne 'sitemap-only') {
return 0;
}
}
return 1;
}
#--------------------------------------------------------------------------------
# traverse the menu tree
#
sub traverse {
my ($cgi, $menu, $level, @levellast) = @_;
my (@items, @subitems, $item, $i, $tag);
my $tag = 'm_' . $menu->{id};
my $open = ($menu->{state} eq 'open' || $cgi->param ($tag));
my ($menurl, $pagurl, $target, $last, $n);
return unless $open;
@items = @{$menu->{item}};
@items = () unless $items[0]->{name};
foreach $item (@items) {
@subitems = @{$item->{item}};
@subitems = () unless $subitems[0]->{name};
$last = lastdisplayeditem($n++, @items);
if (!authorized ($item) || $item->{restrict} eq 'sitemap-only') {
next;
}
if ($#subitems != -1) {
$tag = 'm_' . $item->{id};
$open = ($item->{state} eq 'open' || $cgi->param ($tag));
$menurl = $ENV{REQUEST_URI};
if ($open) {
$menurl =~ s/[\&\?]$tag=1//;
$menurl =~ s/\.pl\&/.pl?/;
$menurl =~ s/&/\&/g;
$pagurl = $menurl;
$target = '_self';
if ($item->{link}) {
$pagurl = $item->{link};
$target = $item->{target};
}
$openmenu_ref->(
$level,
$item->{short} ? $item->{short} : $item->{name},
$pagurl,
get_target ($target),
$menurl,
get_target ('_self'),
$last, @levellast
);
}
else {
$menurl .= $menurl =~ /\?/ ? "\&$tag=1" : "\?$tag=1";
$menurl =~ s/&/\&/g;
$target = '_self';
if ($item->{link}) {
$menurl =~ s/m_$item->{id}=1/m_frame=$item->{id}/;
$target = '_top';
$target = $xml->{setup}->{'top-target'} if $xml->{setup}->{'top-target'};
}
$closedmenu_ref->(
$level,
$item->{short} ? $item->{short} : $item->{name},
$menurl,
get_target ($target),
$menurl,
get_target ($target),
$last, @levellast
);
}
$levellast[$level] = $last;
traverse ($cgi, $item, $level+1, @levellast) if $open;
}
else {
$menuentry_ref->(
$level,
$item->{short} ? $item->{short} : $item->{name},
$item->{link},
get_target ($item->{target}),
$last , @levellast
);
}
}
}
sub get_target {
my ($target) = @_;
$target = $target ? $target : $xml->{setup}->{'default-target'};
$target = " target='$target'" if $target;
return $target;
}
#--------------------------------------------------------------------------------
# generate sitemap to be included by SSL into the according page
#
sub sitemap {
my ($menu, $root) = @_;
my (@items, @subitems, $item, $target);
@items = @{$menu->{item}};
@items = () unless $items[0]->{name};
print "\n" if $root;;
foreach $item (@items) {
@subitems = @{$item->{item}};
@subitems = () unless $subitems[0]->{name};
if (authorized ($item) && $item->{restrict} ne 'menu-only') {
$target = get_target ($item->{target});
if ($#subitems != -1) {
print $item->{link} ?
"- $item->{name}\n
\n" :
"- $item->{name}\n
\n";
sitemap ($item);
print " \n \n";
}
else {
print "- $item->{name}
\n"
unless $item->{restrict} eq 'menu-only';
}
}
}
print " \n" if $root;
}
#-------------------------------------------------------------------------------
# explorer style
#-------------------------------------------------------------------------------
sub explorer_openmenu {
my ($level, $name, $pagurl, $pagtgt, $menurl, $mentgt, $last, @lastlevel) = @_;
explorer_row (
$last ? 'lastnodm' : 'nodem', 'ofolder',
$level, $name, $pagurl, $pagtgt, $menurl, $mentgt, @lastlevel
);
}
sub explorer_closedmenu {
my ($level, $name, $pagurl, $pagtgt, $menurl, $mentgt, $last, @lastlevel) = @_;
explorer_row (
$last? 'lastnodp': 'nodep', 'cfolder',
$level, $name, $pagurl, $pagtgt, $menurl, $mentgt, @lastlevel
);
}
sub explorer_entry {
my ($level, $name, $pagurl, $pagtgt, $last, @lastlevel) = @_;
explorer_row (
$last ? 'lastnode' : 'node', 'link',
$level, $name, $pagurl, $pagtgt, $pagurl, $pagtgt, @lastlevel
);
}
#-------------------------------------------------------------------------------
sub explorer_gif {
my ($img, $url, $target) = @_;
print (" | \n") unless $img;
return unless $img;
$target = ($url =~ /m_frame/) ? " target='$top'" : "";
if ($url) {
print ("  | \n");
}
else {
print (" | \n");
}
}
sub explorer_row {
my ($ngif, $fgif, $level, $name, $pagurl, $pagtgt, $menurl, $mentgt, @levellast) = @_;
my $i;
my $span = $MAXLEVEL - 2 - $level;
print " \n";
for ($i = 0; $i < $level; $i++) {
explorer_gif ($levellast[$i] ? '' : 'vertline');
}
explorer_gif ($ngif, $menurl, $mentgt);
explorer_gif ($fgif, $menurl, $mentgt);
print " | $name | \n";
print " \n";
}
#-------------------------------------------------------------------------------
# tablebutton style
#-------------------------------------------------------------------------------
sub tablebutton_openmenu {
my ($level, $name, $pagurl, $pagtgt, $menurl, $mentgt) = @_;
tablebutton_row ('mnudown', 'open', $level, $name, $pagurl, $pagtgt, $menurl, $mentgt);
}
sub tablebutton_closedmenu {
my ($level, $name, $pagurl, $pagtgt, $menurl, $mentgt) = @_;
tablebutton_row ('mnuright', 'closed', $level, $name, $pagurl, $pagtgt, $menurl, $mentgt);
}
sub tablebutton_entry {
my ($level, $name, $pagurl, $pagtgt) = @_;
tablebutton_row ('', 'entry', $level, $name, $pagurl, $pagtgt, $pagurl, $pagtgt);
}
#-------------------------------------------------------------------------------
sub tablebutton_row_old {
my ($symb, $colorid, $level, $name, $pagurl, $pagtgt, $menurl, $mentgt) = @_;
my ($i, $spacer);
$spacer = " ";
$symb = $symb ? " " : "";
print
"\n".
" | \n".
" | \n".
" \n".
"\n".
" | \n".
"\n".
"$spacer$symb".
"$name\n".
" | \n".
" | \n".
" \n".
" | \n";
}
sub tablebutton_row {
my ($symb, $colorid, $level, $name, $pagurl, $pagtgt, $menurl, $mentgt) = @_;
my ($i, $spacer, $width);
$spacer = "";
$symb = $symb ? "" : "";
$width = 4+$level*9 + ($symb ? 9 : 0);
print
"\n".
" | \n".
" | \n".
" \n".
"\n".
" | \n".
"\n".
"$spacer$symb".
" | \n".
"\n".
"$name\n".
" | \n".
" | \n".
" \n".
" | \n";
}
#-------------------------------------------------------------------------------
# table style
#-------------------------------------------------------------------------------
sub arrowtable_openmenu {
my ($level, $name, $pagurl, $pagtgt, $menurl, $mentgt) = @_;
arrowtable_row ('mnudown', 'open1', $level, $name, $pagurl, $pagtgt, $menurl, $mentgt);
}
sub arrowtable_closedmenu {
my ($level, $name, $pagurl, $pagtgt, $menurl, $mentgt) = @_;
arrowtable_row ('mnuright', 'closed1', $level, $name, $pagurl, $pagtgt, $menurl, $mentgt);
}
sub arrowtable_entry {
my ($level, $name, $pagurl, $pagtgt) = @_;
arrowtable_row ('', 'entry1', $level, $name, $pagurl, $pagtgt, $pagurl, $pagtgt);
}
#-------------------------------------------------------------------------------
sub arrowtable_row {
my ($symb, $colorid, $level, $name, $pagurl, $pagtgt, $menurl, $mentgt) = @_;
my ($i, $spacer);
$spacer = "";
$symb = $symb ? "" : "";
print
"\n".
"| ".
"$spacer$symb".
"$name".
" | \n".
" | \n";
}
|
|