package Blikistan::MagicEngine::PerlSite; use strict; use warnings; use base 'Blikistan::MagicEngine::TT2'; use base 'Blikistan::MagicEngine::YamlConfig'; use URI::Escape; use JSON; =head1 NAME Blikistan::MagicEngine::PerlSite =head1 SYNOPSIS use Blikistan; my $b = Blikistan->new( magic_engine => 'perlSite', rester => $rester, magic_opts => \%magic_opts, ); =head1 DESCRIPTION MagicEngine for Blikistan designed for presenting Wiki content as a web 1.0 website. =cut sub print_blog { my $self = shift; my $r = $self->{rester}; my $params = $self->load_config($r); $params->{rester} = $r; $params->{blog_tag} ||= $self->{blog_tag}; my $page = $self->{subpage} || $params->{start_page}; # Need to get the metadata here $r->accept('application/json'); my $return = _get_page($r, $page); my $page_obj = jsonToObj($return); my $page_name = $page_obj->{name}; my $page_uri = $page_obj->{page_uri}; # If we're searching, do the search thing $r->accept('text/html'); my $nav = _get_page($r, $params->{nav_page}, $params->{base_uri}, $page_uri); my ($page_content); if ( $self->{search} ) { $page_content = _search($r, $self->{search}, $params->{base_uri}, 'search'); } else { $page_content = _get_page($r, $page, $params->{base_uri}, $page_uri); $page_content = "

$page_name

\n$page_content"; } $params->{nav} = $nav; $params->{page} = $page_content; return $self->render_template( $params ); } sub _fix_links { my $r = shift; my $base_uri = shift; my $page_uri = shift; my $page_content = shift; my $return; $base_uri =~ s#/hydra##g; # Interesting pieces of the page URI my ($server_uri, $workspace, $page_name) = ($page_uri =~ m#(https?://[^/]+)/([^/]+)/.*\?(.*)$#); # Now we can build the internal REST links my $rest_page_uri = "/data/workspaces/$workspace/pages/"; my @links = ($page_content =~ m/href=["']([^'"]+)["']/g); foreach my $link (@links) { if ( $link =~ m#^[^/]+$# ) { $page_content =~ s/href=(.)$link/href=$1$base_uri$link/g; } elsif ( $link =~ m/^$rest_page_uri/ ) { $page_content =~ s/$rest_page_uri/$base_uri/g; } elsif ( $link =~ m/^pages/ ) { $page_content =~ s/href='pages\//href='$base_uri/g; } } my %seen; my @image_links = ($page_content =~ m/src=["']([^'"]+)["']/g); foreach my $link (@image_links) { next if $seen{$link}++; if ( $link =~ m/attachments/ ) { $page_content =~ s/$link/$server_uri\/$link/g; } else { warn "$link has no attachments\n"; } } return $page_content; } sub _search { my $r = shift; my $query_string = shift; my $base_uri = shift; my $page_uri = shift; $r->accept('text/html'); $r->query($query_string); my $return = $r->get_pages(); $return = _fix_links ($r, $base_uri, $page_uri, $return); return $return; } sub _get_page { my $r = shift; my $page_name = shift; my $base_uri = shift; my $page_uri = shift; my $html = $r->get_page($page_name) || ''; $html =~ s#^
(.+)
\s*$#$1#s; $html = _fix_links ($r, $base_uri, $page_uri, $html); return $html; } =head1 AUTHOR Kirsten L. Jones<< >> =head1 COPYRIGHT & LICENSE Copyright 2006 Kirsten L. Jones, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1;