[# tag: auto-indexing script This builds up the following data structures used to create the index page: @clusters - array of cluster names, from directories or auto.ini sections $dir{$cluster} - hash pointing to cluster targets (scalar strings) $items{$cluster} - hash pointing to cluster items (arrayref of item names) $order{$cluster} - hash of cluster order values (scalar floats) #] [! use Ewok::File qw(readdir); use Ewok::Authz qw(:common); use Ewok::Meta qw(&getMeta); use Ewok::Parse qw(&parseFileIni); use URI::Escape; !] [- $req = shift; $fs_dir = $req->{fs_dir}; $header = "$fs_dir/auto-header.html" if -f "$fs_dir/auto-header.html"; $footer = "$fs_dir/auto-footer.html" if -f "$fs_dir/auto-footer.html"; $leader = "$fs_dir/auto-leader.html" if -f "$fs_dir/auto-leader.html"; $right = "$fs_dir/auto-right.html" if -f "$fs_dir/auto-right.html"; if ($right) { $colwidth1 = '40%'; $colwidth2 = '220'; } else { $colwidth1 = '50%'; } $h1 = $req->{h1}; $h1 ||= $req->{dir}->{title}; ($h1 = $fs_dir) =~ s|^.*/([^/]+)/?$|\u$1|o if ! $h1; ($d, $f) = readdir($fs_dir, { web_dir => $ENV{SCRIPT_NAME} }); @clusters = (); %dir = (); %items = (); %redirect = (); # Check promotions from directories for my $dir (@$d) { my $meta = getMeta("$fs_dir/$dir", { inherit => 'N' }); if ($meta->{promote_dir}) { my $cluster = $meta->{promote_title} || $meta->{title} || "\u$dir"; push @clusters, $cluster; $dir{$cluster} = $dir; $items{$cluster} = []; for my $item (split(/\s*,\s*/, $meta->{promote_items})) { $item = "$dir/$item"; $item .= '/' if -d $item; push @{$items{$cluster}}, $item; } $order{$cluster} = exists($meta->{promote_order}) ? $meta->{promote_order} : 5; } } # Check files for my $file (@$f) { my $meta = getMeta("$fs_dir/$file"); if ($cluster = $meta->{cluster}) { if (! exists $dir{$cluster}) { push @clusters, $cluster; $dir{$cluster} = ''; $order{$cluster} = 5; } if (ref $items{$cluster} eq 'ARRAY') { push @{$items{$cluster}}, $file; } else { $items{$cluster} = [ $file ]; } $ititle{$file} = $meta->{title} || $file; $iorder{$file} = $meta->{item_order} || 5; $redirect{$file} = $meta->{redirect} if $meta->{redirect}; if (exists $meta->{cluster_order} && (! exists $order{$cluster} || $order{$cluster} == 5)) { $order{$cluster} = $meta->{cluster_order}; } } } # Check auto.ini my $iniFile = "$fs_dir/auto.ini"; if (-f $iniFile) { my $ini = parseFileIni($iniFile, { duplicates => 'unique' }); for my $cluster (keys %$ini) { if (! exists $dir{$cluster}) { push @clusters, $cluster; $dir{$cluster} = ''; $order{$cluster} = 5; } for my $i (keys %{$ini->{$cluster}}) { if ($i eq 'order' && (! exists $order{$cluster} || $order{$cluster} == 5)) { $order{$cluster} = $ini->{$cluster}->{$i}; } elsif ($i =~ m/^item/) { my $item = $ini->{$cluster}->{$i}; my ($text, $rest, $label, $href, $id, $iorder, $split); if ($item =~ m/^\s*'/o) { ($text, $rest) = ($item =~ m/^\s*'([^']+)'\s*[,|](.*?)\s*$/o); $split = (($rest =~ m/\|/o) ? '\|' : ','); ($id, $iorder) = split /\s*$split\s*/, $rest; } else { $split = (($item =~ m/\|/o) ? '\|' : ','); ($label, $href, $id, $iorder) = split /\s*$split\s*/, $item; } if ($text || ($label && $href)) { my $tag = "${cluster}:$i"; if (ref $items{$cluster} eq 'ARRAY') { push @{$items{$cluster}}, $tag; } else { $items{$cluster} = [ $tag ]; } $iorder{$tag} = $iorder || 5; if ($text) { $ititle{$tag} = $text; $redirect{$tag} = 'TEXT'; } else { $ititle{$tag} = $label; $redirect{$tag} = $href; } } } } } } # An item with the same name as the cluster redefines the cluster for my $c (@clusters) { for (my $i = 0; $i < @{$items{$c}}; $i++) { #> my $f = ${$items{$c}}[$i]; if ($ititle{$f} eq $c) { splice @{$items{$c}}, $i, 1; $redirect{$c} = $redirect{$f} || $f; $dir{$c} = $redirect{$f} || $f if ! $dir{$c}; $order{$c} = $iorder{$f} if $iorder{$f} ne 5; } } } # Check for single-item clusters with the same name # for my $c (@clusters) { # if (scalar @{$items{$c}} == 1) { # my $f = ${$items{$c}}[0]; # if ($ititle{$f} eq $c) { # $items{$c} = []; # $dir{$c} = $redirect{$f} || $f; # $order{$c} = $iorder{$f} if $iorder{$f} ne 5; # } # } # } @clusters = sort { return $order{$a} <=> $order{$b} || uc($a) cmp uc($b) } @clusters; $break = int((scalar(@clusters)+1)/2) if scalar @clusters > 3; $break-- if $leader; if (@background = glob "auto-background\.*") { $bg = qq( background="$background[0]"); } -]

[+ $h1 +]

[# Header #] [$ if ($header) $]
[- Execute $header -]
[$ endif $] [# Body #] [$ if ($right) $] [$ endif $]
[$ if ($leader) $][- Execute $leader -][$ endif $] [- $i = 0; -][$ foreach $c (@clusters) $] [- $i++; -][$ if ($dir{$c}) $][+ $escmode = 0; ($c1 = $c) =~ s/\s+/ /og; $c1 +][$ else $][+ $c +][$ endif $]
[- # Load item metadata my @reject = (); for (my $i = 0; $i < scalar(@{$items{$c}}); $i++) { my $item = ${$items{$c}}[$i]; if (! $ititle{$item}) { my $meta = getMeta("$fs_dir/$item"); my $iniFile = "$fs_dir/$dir{$c}/auto.ini"; my $ini = ''; $ini = parseFileIni($iniFile, { duplicates => 'unique' }) if -f $iniFile; # Promoted items we won't know about yet - check metadata if (keys %$meta) { $ititle{$item} = $meta->{promote_title} || $meta->{short_title} || $meta->{title}; $redirect{$item} = $meta->{redirect} if $meta->{redirect}; $iorder{$item} = $meta->{item_order} || $meta->{promote_order} || 5; } # If not in metadata, check if they're in the relevant auto.ini else { my ($itemdir, $itemid) = ($item =~ m|^(.*)/([^/]+)$|o); $req->{req_rec}->error("auto.html: dir $dir{$c} for cluster $c " . "does not match item stem $itemdir (item $item)") if $itemdir ne $dir{$c}; if ($ini) { # Iterate through all 'items' checking for this $itemid INI: for my $cluster (keys %$ini) { for my $i (keys %{$ini->{$cluster}}) { next if substr($i, 0, 4) ne 'item'; my $split = (($ini->{$cluster}->{$i} =~ m/\|/o) ? '\|' : ','); my ($label, $href, $id, $iorder) = split /\s*$split\s*/, $ini->{$cluster}->{$i}; next if $id ne $itemid || ! $label || ! $href; # Found! $ititle{$item} = $label; if (substr($href,0,1) eq '/' || $href =~ m|^https?://|o) { $redirect{$item} = $href; } else { $redirect{$item} = "$dir{$c}/$href"; } $iorder{$item} = $iorder || 5; last INI; } } } } # If still untitled, remove unless definitely found if (! $ititle{$item}) { if ($redirect{$item} || -e $item) { ($ititle{$item}) = ($item =~ m|/([^/]+)/?$|o); } else { push @reject, $i; } } } } @items = @{$items{$c}}; for my $r (@reject) { splice @items, $r, 1; } @items = sort { return $iorder{$a} <=> $iorder{$b} || uc($ititle{$a}) cmp uc($ititle{$b}) } @items; -] [$ if (@items) $][- $j = 0; -][$ foreach $item (@items) $][+ $escmode = 0; " | " if $j > 0 +] [$ if ($redirect{$item} eq 'TEXT') $][+ $ititle{$item} +][$ else $][+ $ititle{$item} =~ s/\s+/ /og; $ititle{$item} +][$ endif $][- $j++ -][$ endforeach $]
[$ endif $]
[$ if ($i == $break) $]
[$ endif $] [$ endforeach $] [- Execute $right -]
[# Footer #] [$ if ($footer) $]
[- Execute $footer -]
[$ endif $]