File Coverage

blib/lib/WebEditor/OldFeatures/XMenus.pm
Criterion Covered Total %
statement 18 103 17.4
branch 0 42 0.0
condition 0 15 0.0
subroutine 6 12 50.0
pod 0 3 0.0
total 24 175 13.7


line stmt bran cond sub pod time code
1             package WebEditor::OldFeatures::XMenus;
2              
3 1     1   1130 use strict;
  1         2  
  1         28  
4 1     1   6 use vars qw($VERSION @EXPORT);
  1         2  
  1         98  
5             $VERSION = sprintf("%d.%02d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/);
6 1     1   5 use base qw(Exporter);
  1         1  
  1         146  
7              
8             @EXPORT = qw(makemenu makemenu_string); # mixin
9              
10 1     1   10 use CGI qw(param);
  1         1  
  1         8  
11 1     1   141 use HTML::Entities ();
  1         2  
  1         18  
12              
13 1     1   5 use WE::Util::LangString qw(langstring);
  1         2  
  1         1023  
14              
15             ######################################################################
16             #
17             # create the menu
18             #
19             sub makemenu_string {
20 0     0 0   my $self = shift;
21 0           my %args = @_;
22              
23 0           my $root = $self->Root;
24 0           my $objdb = $root->ObjDB;
25 0           my $c = $self->C;
26              
27 0           my $root_id = $args{startid};
28 0 0         $root_id = $objdb->root_object->Id if !defined $args{startid};
29 0   0       my $lang = $args{lang} || $c->project->sitelanguages->[0];
30              
31 0           my $out = "";
32 0           my $indent = 0;
33 0           my %ul_done;
34              
35             # XXX maybe use ::prune instead?
36             my $is_visible = sub {
37 0     0     my $obj = shift;
38 0           my @pathobj = $objdb->pathobjects($obj);
39 0           shift @pathobj; # ignore site object
40 0           for my $o (@pathobj) {
41 0 0 0       return 0 if ($o->is_folder && !$o->{VisibleToMenu});
42             }
43 0           1;
44 0           };
45              
46             my $handle_pre = sub {
47 0     0     my($objid) = @_;
48 0           my $obj = $objdb->get_object($objid);
49 0 0         return if !$is_visible->($obj);
50 0           my($depth) = $objdb->depth($obj);
51 0 0         if ($obj->is_folder) {
52 0 0         if ($depth >= 2) {
53 0           my $indexdoc = $obj->IndexDoc;
54 0           my $href;
55             # XXX Better use WE_Navigation::Object::relurl logic
56             # here???
57 0 0 0       if (!defined $indexdoc || $indexdoc eq "") {
58 0           my @children = $objdb->get_released_children($objid);
59 0 0         if (@children) {
60 0           $indexdoc = $children[0]->Id;
61             }
62             }
63 0 0         if (defined $indexdoc) {
64 0           $href = $indexdoc . "." . get_ext($self, $indexdoc);
65             }
66 0 0         $out .= " "x$indent .
    0          
67             "
  • " . (defined $href ? "" : "") .
  • 68             HTML::Entities::encode(langstring($obj->Title, $lang)) .
    69             (defined $href ? "" : "") . "\n";
    70             }
    71 0           $indent++;
    72             } else {
    73 0           my $fldr_depth = $depth-1;
    74 0 0         if (!$ul_done{$fldr_depth}) {
    75 0           $out .= " "x($indent-1) . "
    76 0 0         if ($fldr_depth < 2) {
    77 0           $out .= " id='myMenu1' class='myBar'";
    78             } else {
    79 0           $out .= " class='myBox'";
    80             }
    81 0           $out .= ">\n";
    82 0 0 0       if ($fldr_depth == 1 && $args{homelink}) {
    83             # XXX do not hardcode name, label and extension!
    84 0           $out .= "
  • Home
  • \n";
    85             }
    86 0           $ul_done{$fldr_depth}++;
    87             }
    88              
    89 0 0         if ($depth >= 3) {
    90 0           $out .= " "x$indent .
    91             "
  • " .
  • 92             HTML::Entities::encode(langstring($obj->Title, $lang)) .
    93             "\n";
    94             }
    95             }
    96 0           };
    97              
    98             my $handle_post = sub {
    99 0     0     my($objid) = @_;
    100 0           my $obj = $objdb->get_object($objid);
    101 0 0         return if !$is_visible->($obj);
    102 0 0         if ($obj->is_folder) {
    103 0           my($depth) = $objdb->depth($obj);
    104 0           $indent--;
    105 0 0         if ($ul_done{$depth}) {
    106 0           $out .= " "x$indent . "";
    107 0           delete $ul_done{$depth};
    108             }
    109 0 0         if ($depth >= 2) {
    110 0           $out .= "";
    111             }
    112 0           $out .= "\n";
    113             }
    114 0           };
    115              
    116 0           $objdb->walk_prepostorder($root_id, $handle_pre, $handle_post);
    117              
    118 0           $out;
    119             }
    120              
    121             sub makemenu {
    122 0     0 0   my $self = shift;
    123              
    124 0           my $c = $self->C;
    125 0           my %args;
    126 0 0 0       if ($c->project->projectext && $c->project->projectext->{xmenus}) {
    127 0           %args = %{ $c->project->projectext->{xmenus} };
      0            
    128             }
    129              
    130 0           for my $lang (@{ $c->project->sitelanguages }) {
      0            
    131 0           $args{lang} = $lang;
    132 0           my $out = $self->makemenu_string(%args);
    133 0           my $menufile = $c->paths->pubhtmldir . "/html/$lang/_menu.html";
    134 0 0         open(OUT, ">$menufile") or die "Can't write $menufile: $!";
    135 0           print OUT $out;
    136 0           close OUT;
    137             }
    138             }
    139              
    140             # Hack to get extension by object id. There should be a better means,
    141             # e.g. storing the extension into the object or so.
    142             sub get_ext {
    143 0     0 0   my($self, $objid) = @_;
    144 0           my $c = $self->C;
    145 0           my $lang = $c->project->sitelanguages->[0];
    146 0           my $rootdir = $c->paths->rootdir . "/html/$lang/";
    147 0           my @files = glob("$rootdir/$objid.*");
    148 0           for my $f (@files) {
    149 0 0         if ($f =~ m{/$objid\.(.*?)$}) {
    150 0           return $1;
    151             }
    152             }
    153 0           return "html"; # fallback
    154             }
    155              
    156             1;