package Trog::Routes::HTML; use strict; use warnings; no warnings 'experimental'; use feature qw{signatures state}; use Errno qw{ENOENT}; use File::Touch(); use List::Util(); use List::MoreUtils(); use Capture::Tiny qw{capture}; use HTML::SocialMeta; use Trog::Utils; use Trog::Config; use Trog::Data; my $conf = Trog::Config::get(); my $template_dir = 'www/templates'; my $theme_dir = ''; $theme_dir = "themes/".$conf->param('general.theme') if $conf->param('general.theme') && -d "www/themes/".$conf->param('general.theme'); my $td = $theme_dir ? "/$theme_dir" : ''; use lib 'www'; our $landing_page = 'default.tx'; our $htmltitle = 'title.tx'; our $midtitle = 'midtitle.tx'; our $rightbar = 'rightbar.tx'; our $leftbar = 'leftbar.tx'; our $topbar = 'topbar.tx'; our $footbar = 'footbar.tx'; # Note to maintainers: never ever remove backends from this list. # the auth => 1 is a crucial protection, even with forbidden() guards in these routes. our %routes = ( default => { callback => \&Trog::Routes::HTML::setup, }, '/' => { method => 'GET', callback => \&Trog::Routes::HTML::index, }, #Deal with most indexDocument directives interfering with proxied requests to / '/index.html' => { method => 'GET', callback => \&Trog::Routes::HTML::index, }, '/index.php' => { method => 'GET', callback => \&Trog::Routes::HTML::index, }, # This should only be enabled to debug # '/setup' => { # method => 'GET', # callback => \&Trog::Routes::HTML::setup, # }, '/login' => { method => 'GET', callback => \&Trog::Routes::HTML::login, }, '/logout' => { method => 'GET', callback => \&Trog::Routes::HTML::logout, }, '/auth' => { method => 'POST', nostatic => 1, callback => \&Trog::Routes::HTML::login, }, '/post/save' => { method => 'POST', auth => 1, callback => \&Trog::Routes::HTML::post_save, }, '/post/delete' => { method => 'POST', auth => 1, callback => \&Trog::Routes::HTML::post_delete, }, '/config/save' => { method => 'POST', auth => 1, callback => \&Trog::Routes::HTML::config_save, }, '/themeclone' => { method => 'POST', auth => 1, callback => \&Trog::Routes::HTML::themeclone, }, '/profile' => { method => 'POST', auth => 1, callback => \&Trog::Routes::HTML::profile, }, '/manual' => { method => 'GET', auth => 1, callback => \&Trog::Routes::HTML::manual, }, '/lib/(.*)' => { method => 'GET', auth => 1, captures => ['module'], callback => \&Trog::Routes::HTML::manual, }, #TODO transform into posts? '/sitemap', => { method => 'GET', callback => \&Trog::Routes::HTML::sitemap, }, '/sitemap_index.xml', => { method => 'GET', callback => \&Trog::Routes::HTML::sitemap, data => { xml => 1 }, }, '/sitemap_index.xml.gz', => { method => 'GET', callback => \&Trog::Routes::HTML::sitemap, data => { xml => 1, compressed => 1 }, }, '/sitemap/static.xml' => { method => 'GET', callback => \&Trog::Routes::HTML::sitemap, data => { xml => 1, map => 'static' }, }, '/sitemap/static.xml.gz' => { method => 'GET', callback => \&Trog::Routes::HTML::sitemap, data => { xml => 1, compressed => 1, map => 'static' }, }, '/sitemap/(.*).xml' => { method => 'GET', callback => \&Trog::Routes::HTML::sitemap, data => { xml => 1 }, captures => ['map'], }, '/sitemap/(.*).xml.gz' => { method => 'GET', callback => \&Trog::Routes::HTML::sitemap, data => { xml => 1, compressed => 1}, captures => ['map'], }, '/robots.txt' => { method => 'GET', callback => \&Trog::Routes::HTML::robots, }, '/humans.txt' => { method => 'GET', callback => \&Trog::Routes::HTML::posts, data => { tag => ['about'] }, }, '/styles/avatars.css' => { method => 'GET', callback => \&Trog::Routes::HTML::avatars, data => { tag => ['about'] }, }, ); # Grab theme routes my $themed = 0; if ($theme_dir) { my $theme_mod = "$theme_dir/routes.pm"; if (-f "www/$theme_mod" ) { require $theme_mod; @routes{keys(%Theme::routes)} = values(%Theme::routes); $themed = 1; } } =head1 PRIMARY ROUTE =head2 index Implements the primary route used by all pages not behind auth. Most subsequent functions simply pass content to this function. =cut sub index ($query,$render_cb, $content = '', $i_styles = []) { $query->{theme_dir} = $td; my $processor = Text::Xslate->new( path => $template_dir, ); my $t_processor; $t_processor = Text::Xslate->new( path => "www/$theme_dir/templates", ) if $theme_dir; $content ||= _pick_processor("templates/$landing_page",$processor,$t_processor)->render($landing_page,$query); my @styles = ('/styles/avatars.css'); if ($theme_dir) { if ($query->{embed}) { unshift(@styles, _themed_style("embed.css")) if -f 'www/'._themed_style("embed.css"); } unshift(@styles, _themed_style("screen.css")) if -f 'www/'._themed_style("screen.css"); unshift(@styles, _themed_style("print.css")) if -f 'www/'._themed_style("print.css"); unshift(@styles, _themed_style("structure.css")) if -f 'www/'._themed_style("structure.css"); } push( @styles, @$i_styles ); #TODO allow theming of print css my $search_info = Trog::Data->new($conf); my @series = _get_series(0, $search_info); my $title = $query->{primary_post}{title} // $query->{title} // $Theme::default_title // 'tCMS'; # Handle link "unfurling" correctly my ($default_tags, $meta_desc, $meta_tags) = _build_social_meta($query,$title); #Do embed content my $tmpl = $query->{embed} ? 'embed.tx' : 'index.tx'; return $render_cb->( $tmpl, { code => $query->{code}, user => $query->{user}, search_lang => $search_info->lang(), search_help => $search_info->help(), route => $query->{route}, domain => $query->{domain}, theme_dir => $td, content => $content, title => $title, htmltitle => _pick_processor("templates/$htmltitle" ,$processor,$t_processor)->render($htmltitle,$query), midtitle => _pick_processor("templates/$midtitle" ,$processor,$t_processor)->render($midtitle,$query), rightbar => _pick_processor("templates/$rightbar" ,$processor,$t_processor)->render($rightbar,$query), leftbar => _pick_processor("templates/$leftbar" ,$processor,$t_processor)->render($leftbar,$query), topbar => _pick_processor("templates/$topbar" ,$processor,$t_processor)->render($topbar,$query), footbar => _pick_processor("templates/$footbar" ,$processor,$t_processor)->render($footbar,$query), categories => \@series, stylesheets => \@styles, show_madeby => $Theme::show_madeby ? 1 : 0, embed => $query->{embed} ? 1 : 0, embed_video => $query->{primary_post}{is_video}, default_tags => $default_tags, meta_desc => $meta_desc, meta_tags => $meta_tags, deflate => $query->{deflate}, }); } sub _build_social_meta ($query,$title) { return (undef,undef,undef) unless $query->{social_meta} && $query->{route} && $query->{domain}; my $default_tags = $Theme::default_tags; $default_tags .= ','.join(',',@{$query->{primary_post}->{tags}}) if $default_tags && $query->{primary_post}->{tags}; my $meta_desc = $query->{primary_post}{data} // $Theme::description // "tCMS Site"; $meta_desc = Trog::Utils::strip_and_trunc($meta_desc); my $meta_tags = ''; my $card_type = 'summary'; $card_type = 'featured_image' if $query->{primary_post} && $query->{primary_post}{is_image}; $card_type = 'player' if $query->{primary_post} && $query->{primary_post}{is_video}; my $image = $Theme::default_image ? "https://$query->{domain}/$td/$Theme::default_image" : ''; $image = "https://$query->{domain}/$query->{primary_post}{preview}" if $query->{primary_post} && $query->{primary_post}{preview}; $image = "https://$query->{domain}/$query->{primary_post}{href}" if $query->{primary_post} && $query->{primary_post}{is_image}; my $primary_route = "https://$query->{domain}/$query->{route}"; $primary_route =~ s/[\/]+/\//g; my $display_name = $Theme::display_name // 'Another tCMS Site'; my $extra_tags =''; my %sopts = ( site_name => $display_name, app_name => $display_name, title => $title, description => $meta_desc, url => $primary_route, ); $sopts{site} = $Theme::twitter_account if $Theme::twitter_account; $sopts{image} = $image if $image; $sopts{fb_app_id} = $Theme::fb_app_id if $Theme::fb_app_id; if ($query->{primary_post} && $query->{primary_post}{is_video}) { #$sopts{player} = "$primary_route?embed=1"; $sopts{player} = "https://$query->{domain}/$query->{primary_post}{href}"; #XXX don't hardcode this $sopts{player_width} = 1280; $sopts{player_height} = 720; $extra_tags .= "\n"; } my $social = HTML::SocialMeta->new(%sopts); $meta_tags = eval { $social->create($card_type) }; $meta_tags =~ s/content="video"/content="video:other"/mg if $meta_tags; $meta_tags .= $extra_tags if $extra_tags; print STDERR "WARNING: Theme misconfigured, social media tags will not be included\n$@\n" if $theme_dir && !$meta_tags; return ($default_tags, $meta_desc, $meta_tags); } =head1 ADMIN ROUTES These are things that issue returns other than 200, and are not directly accessible by users via any defined route. =head2 notfound, forbidden, badrequest Implements the 4XX status codes. Override templates named the same for theming this. =cut sub _generic_route ($rname, $code, $title, $query, $render_cb) { $query->{code} = $code; my $processor = Text::Xslate->new( path => _dir_for_resource("$rname.tx"), ); $query->{title} = $title; my $styles = _build_themed_styles("$rname.css"); my $content = $processor->render("$rname.tx", { title => $title, route => $query->{route}, user => $query->{user}, styles => $styles, deflate => $query->{deflate}, }); return Trog::Routes::HTML::index($query, $render_cb, $content, $styles); } sub notfound (@args) { return _generic_route('notfound',404,"Return to sender, Address unknown", @args); } sub forbidden (@args) { return _generic_route('forbidden', 403, "STAY OUT YOU RED MENACE", @args); } sub badrequest (@args) { return _generic_route('badrequest', 400, "Bad Request", @args); } sub redirect ($to) { return [302, ["Location" => $to],['']] } sub redirect_permanent ($to) { return [301, ["Location" => $to], ['']]; } =head1 NORMAL ROUTES These are expected to either return a 200, or redirect to something which does. =head2 robots Return an appropriate robots.txt =cut sub robots ($query, $render_cb) { my $processor = Text::Xslate->new( path => $template_dir, ); return [200, ["Content-type:text/plain\n"],[$processor->render('robots.tx', { domain => $query->{domain} })]]; } =head2 setup One time setup page; should only display to the first user to visit the site which we presume to be the administrator. =cut sub setup ($query, $render_cb) { File::Touch::touch("config/setup"); return $render_cb->('notconfigured.tx', { title => 'tCMS Requires Setup to Continue...', stylesheets => _build_themed_styles('notconfigured.css'), }); } =head2 login Sets the user cookie if the provided user exists, or sets up the user as an admin with the provided credentials in the event that no users exist. =cut sub login ($query, $render_cb) { # Redirect if we actually have a logged in user. # Note to future me -- this user value is overwritten explicitly in server.psgi. # If that ever changes, you will die $query->{to} //= $query->{route}; $query->{to} = '/config' if $query->{to} eq '/login'; if ($query->{user}) { return $routes{$query->{to}}{callback}->($query,$render_cb); } #Check and see if we have no users. If so we will just accept whatever creds are passed. $query->{'hasusers'} = -f "config/has_users"; my $btnmsg = $query->{'hasusers'} ? "Log In" : "Register"; my @headers; my $do_auth = grep { $query->{$_} } qw{username extAuthProvider}; my $failed = -1; if($do_auth) { my $auth_module = "Default"; $auth_module = ucfirst($query->{'extAuthProvider'}) if($query->{'extAuthProvider'}); require Trog::Authz; my $auth_obj = Trog::Authz::do_auth_for( $auth_module, $query ); $failed = $auth_obj->failed(); @headers = $auth_obj->headers(); } return $render_cb->('login.tx', { title => 'tCMS 2 ~ Login', to => $query->{to}, failure => int( $failed ), message => int( $failed ) == 0 ? "Login Successful, Redirecting..." : "Login Failed.", btnmsg => $btnmsg, hasusers => $query->{'hasusers'} ? 1 : 0, stylesheets => _build_themed_styles('login.css'), theme_dir => $td, }, @headers); } =head2 logout Deletes your users' session and opens the index. =cut sub logout ($query, $render_cb) { Trog::Auth::killsession($query->{user}) if $query->{user}; delete $query->{user}; return Trog::Routes::HTML::index($query,$render_cb); } =head2 config Renders the configuration page, or redirects you back to the login page. =cut sub config ($query, $render_cb) { if (!$query->{user}) { return login($query,$render_cb); } #NOTE: we are relying on this to skip the ACL check with 'admin', this may not be viable in future? return forbidden($query, $render_cb) unless grep { $_ eq 'admin' } @{$query->{acls}}; my $css = _build_themed_styles('config.css'); my $js = _build_themed_scripts('post.js'); $query->{failure} //= -1; my @series = _get_series(1); return $render_cb->('config.tx', { title => 'Configure tCMS', theme_dir => $td, stylesheets => $css, scripts => $js, categories => \@series, themes => _get_themes() || [], data_models => _get_data_models(), current_theme => $conf->param('general.theme') // '', current_data_model => $conf->param('general.data_model') // 'DUMMY', message => $query->{message}, failure => $query->{failure}, to => '/config', }); } sub _get_series($edit=0,$search_info=0) { $search_info ||= Trog::Data->new($conf); my @series = $search_info->get( acls => [qw{public}], tags => [qw{topbar}], limit => 10, page => 1, ); @series = map { $_->{local_href} = "/post$_->{local_href}"; $_ } @series if $edit; return @series; } sub _get_themes { my $dir = 'www/themes'; opendir(my $dh, $dir) || do { die "Can't opendir $dir: $!" unless $!{ENOENT} }; my @tdirs = grep { !/^\./ && -d "$dir/$_" } readdir($dh); closedir $dh; return \@tdirs; } sub _get_data_models { my $dir = 'lib/Trog/Data'; opendir(my $dh, $dir) || die "Can't opendir $dir: $!"; my @dmods = map { s/\.pm$//g; $_ } grep { /\.pm$/ && -f "$dir/$_" } readdir($dh); closedir $dh; return \@dmods } =head2 config_save Implements /config/save route. Saves what little configuration we actually use to ~/.tcms/tcms.conf =cut sub config_save ($query, $render_cb) { return forbidden($query, $render_cb) unless grep { $_ eq 'admin' } @{$query->{acls}}; $conf->param( 'general.theme', $query->{theme} ) if defined $query->{theme}; $conf->param( 'general.data_model', $query->{data_model} ) if $query->{data_model}; $query->{failure} = 1; $query->{message} = "Failed to save configuration!"; if ($conf->write($Trog::Config::home_cfg)) { $query->{failure} = 0; $query->{message} = "Configuration updated succesfully."; } #Get the PID of the parent port using lsof, send HUP my $parent = getppid; kill 'HUP', $parent; return config($query, $render_cb); } =head2 themeclone Clone a theme by copying a directory. =cut sub themeclone ($query, $render_cb) { return forbidden($query, $render_cb) unless grep { $_ eq 'admin' } @{$query->{acls}}; my ($theme, $newtheme) = ($query->{theme},$query->{newtheme}); my $themedir = 'www/themes'; $query->{failure} = 1; $query->{message} = "Failed to clone theme '$theme' as '$newtheme'!"; require File::Copy::Recursive; if ($theme && $newtheme && File::Copy::Recursive::dircopy( "$themedir/$theme", "$themedir/$newtheme" )) { $query->{failure} = 0; $query->{message} = "Successfully cloned theme '$theme' as '$newtheme'."; } return config($query, $render_cb); } =head2 post_save Saves posts submitted via the /post pages =cut sub post_save ($query, $render_cb) { return forbidden($query, $render_cb) unless grep { $_ eq 'admin' } @{$query->{acls}}; my $to = delete $query->{to}; #Copy this down since it will be deleted later my $acls = $query->{acls}; state $data = Trog::Data->new($conf); $query->{tags} = _coerce_array($query->{tags}); # Filter bits and bobs delete $query->{primary_post}; delete $query->{social_meta}; delete $query->{deflate}; delete $query->{acls}; # Ensure there are no null tags @{$query->{tags}} = grep { defined $_ } @{$query->{tags}}; $query->{failure} = $data->add($query); $query->{to} = $to; $query->{acls} = $acls; $query->{message} = $query->{failure} ? "Failed to add post!" : "Successfully added Post"; delete $query->{id}; return posts($query, $render_cb); } =head2 profile Saves / updates new users. =cut sub profile ($query, $render_cb) { return forbidden($query, $render_cb) unless grep { $_ eq 'admin' } @{$query->{acls}}; #TODO allow users to do something OTHER than be admins if ($query->{password}) { Trog::Auth::useradd($query->{username}, $query->{password}, ['admin'] ); } #Make sure it is "self-authored", redact pw $query->{user} = delete $query->{username}; delete $query->{password}; return post_save($query, $render_cb); } =head2 post_delete deletes posts. =cut sub post_delete ($query, $render_cb) { return forbidden($query, $render_cb) unless grep { $_ eq 'admin' } @{$query->{acls}}; state $data = Trog::Data->new($conf); $query->{failure} = $data->delete($query); $query->{to} = $query->{to}; $query->{message} = $query->{failure} ? "Failed to delete post $query->{id}!" : "Successfully deleted Post $query->{id}"; delete $query->{id}; return posts($query, $render_cb); } =head2 series Series specific view, much like the users/ route Displays identified series, not all series. =cut sub series ($query, $render_cb) { my $is_admin = grep { $_ eq 'admin' } @{$query->{acls}}; #we are either viewed one of two ways, /post/$id or /$aclname my (undef,$aclname,$id) = split(/\//,$query->{route}); $query->{aclname} = $aclname if !$id; $query->{id} = $id if $id; # Don't show topbar series on the series page. That said, don't exclude it from direct series view. $query->{exclude_tags} = ['topbar'] if !$is_admin && $aclname && $aclname eq 'series'; #XXX I'd prefer to overload id to actually *be* the aclname... # but this way, accomodates things like the flat file time-indexing hack. # TODO I should probably have it for all posts, and make *everything* a series. # WE can then do threaded comments/posts. # That will essentially necessitate it *becoming* the ID for real. #Grab the relevant tag (aclname), then pass that to posts my @posts = _post_helper($query, ['series'], $query->{acls}); delete $query->{id}; delete $query->{aclname}; $query->{subhead} = $posts[0]->{data}; $query->{title} = $posts[0]->{title}; $query->{tag} = $posts[0]->{aclname}; $query->{primary_post} = $posts[0]; $query->{in_series} = 1; return posts($query,$render_cb); } =head2 avatars Returns the avatars.css. Limited to 1000 users. =cut sub avatars ($query, $render_cb) { #XXX if you have more than 1000 editors you should stop push(@{$query->{acls}}, 'public'); my $tags = _coerce_array($query->{tag}); my $processor = Text::Xslate->new( function => { css_escape => sub { my ( $str ) = @_; return '' if !$str; $str =~ s/([!"#$%&'()*+,.\/:;<=>?@\[\\\]^`{|}~-]+)/\\$1/g; return $str; }, }, path => $template_dir, ); my @posts = _post_helper($query, $tags, $query->{acls}); my $content = $processor->render('avatars.tx', { users => \@posts, }); return [200, ["Content-type" => "text/css" ],[$content]]; } =head2 users Implements direct user profile view. =cut sub users ($query, $render_cb) { # Capture the username my (undef, undef, $username) = split(/\//, $query->{route}); $query->{username} //= $username; push(@{$query->{acls}}, 'public'); $query->{exclude_tags} = ['about']; # Don't show topbar series on the series page. That said, don't exclude it from direct series view. my $is_admin = grep { $_ eq 'admin' } @{$query->{acls}}; push(@{$query->{exclude_tags}}, 'topbar') if !$is_admin; my @posts = _post_helper({ author => $query->{username} }, ['about'], $query->{acls}); $query->{id} = $posts[0]->{id}; $query->{title} = $posts[0]->{title}; $query->{user_obj} = $posts[0]; $query->{primary_post} = $posts[0]; $query->{in_series} = 1; return posts($query,$render_cb); } =head2 posts Display multi or single posts, supports RSS and pagination. =cut sub posts ($query, $render_cb, $direct=0) { #Process the input URI to capture tag/id $query->{route} //= $query->{to}; my (undef, undef, $id) = split(/\//, $query->{route}); my $tags = _coerce_array($query->{tag}); $query->{id} = $id if $id && !$query->{in_series}; my $is_admin = grep { $_ eq 'admin' } @{$query->{acls}}; push(@{$query->{acls}}, 'public'); push(@{$query->{acls}}, 'unlisted') if $query->{id}; push(@{$query->{acls}}, 'private') if $is_admin; my @posts; # Discover this user's visibility, so we can make them post in this category by default my $user_visibility = 'public'; if ($query->{user_obj}) { #Optimize the /users/* route @posts = ($query->{user_obj}); $user_visibility = $query->{user_obj}->{visibility}; } else { if ($query->{user}) { my @me = _post_helper({ author => $query->{user} }, ['about'], $query->{acls}); $user_visibility = $me[0]->{visibility}; } @posts = _post_helper($query, $tags, $query->{acls}); } if ($query->{id}) { $query->{primary_post} = $posts[0] if @posts; } #OK, so if we have a user as the ID we found, go grab the rest of their posts if ($query->{id} && @posts && grep { $_ eq 'about'} @{$posts[0]->{tags}} ) { my $user = shift(@posts); my $id = delete $query->{id}; $query->{author} = $user->{user}; @posts = _post_helper($query, $tags, $query->{acls}); @posts = grep { $_->{id} ne $id } @posts; unshift @posts, $user; } if (!$is_admin) { return notfound($query, $render_cb) unless @posts; } my $fmt = $query->{format} || ''; return _rss($query,\@posts) if $fmt eq 'rss'; my $processor = Text::Xslate->new( path => $template_dir, function => { render_it => sub { my ($template_string, $options) = @_; return Text::Xslate->new( # Prevent a recursive descent. If the renderer is hit again, just do nothing # XXX unfortunately if the post tries to include itself, it will die. function => { embed => sub { my ($this_id, $style) = @_; $style //= 'embed'; # If instead the style is 'content', then we will only show the content w/ no formatting, and no title. return Text::Xslate::mark_raw(Trog::Routes::HTML::posts( { route => "/post/$this_id", style => $style }, sub {}, 1)); }, }, )->render_string($template_string,$options); }, }, ); #XXX Is used by the sitemap, maybe just fix there? my @post_aliases = map { $_->{local_href} } _get_series(); my ($header,$footer); my $t_processor; $t_processor = Text::Xslate->new( path => "www/$theme_dir/templates", ) if $theme_dir; $header = _pick_processor('templates/headers/'.$query->{primary_post}{header}, $processor,$t_processor)->render('headers/'.$query->{primary_post}{header}, { theme_dir => $td } ) if $query->{primary_post}{header}; $footer = _pick_processor('templates/footers/'.$query->{primary_post}{footer}, $processor,$t_processor)->render('footers/'.$query->{primary_post}{footer}, { theme_dir => $td } ) if $query->{primary_post}{footer}; # List the available headers/footers my $headers = _templates_in_dir($theme_dir ? "www/$theme_dir/templates/headers" : "www/templates/headers"); my $footers = _templates_in_dir($theme_dir ? "www/$theme_dir/templates/footers" : "www/templates/footers"); my $styles = _build_themed_styles('posts.css'); #Correct page headers my $ph = $themed ? _themed_title($query->{route}) : $query->{route}; # Build page title if it wasn't set by a wrapping sub $query->{title} = "$query->{domain} : $query->{title}" if $query->{title} && $query->{domain}; $query->{title} ||= @$tags && $query->{domain} ? "$query->{domain} : @$tags" : undef; #Handle paginator vars my $limit = int($query->{limit} || 25); my $now_year = (localtime(time))[5] + 1900; my $oldest_year = $now_year - 20; #XXX actually find oldest post year # Handle post style. if ($query->{style}) { undef $header; undef $footer; } my $older = !@posts ? 0 : $posts[-1]->{created}; $query->{failure} //= -1; $query->{id} //= ''; #XXX messed up data has to be fixed unfortunately @$tags = List::Util::uniq @$tags; #Filter displaying visibility tags my @visibuddies = qw{public unlisted private}; foreach my $post (@posts) { @{$post->{tags}} = grep { my $tag = $_; !grep { $tag eq $_ } @visibuddies } @{$post->{tags}}; } #XXX note that we are explicitly relying on the first tag to be the ACL my $aclselected = $tags->[0] || ''; my @acls = map { $_->{selected} = $_->{aclname} eq $aclselected ? 'selected' : ''; $_ } _post_helper({}, ['series'], $query->{acls}); my $forms = _templates_in_dir("$template_dir/forms"); my $edittype = $query->{primary_post} ? $query->{primary_post}->{child_form} : $query->{form}; my $tiled = $query->{primary_post} ? !$is_admin && $query->{primary_post}->{tiled} : 0; # Grab the rest of the tags to dump into the edit form state $data = Trog::Data->new($conf); my @tags_all = $data->tags(); #Filter out the visibilities and special series tags @tags_all = grep { my $subj = $_; scalar(grep { $_ eq $subj } qw{public private unlisted admin series about topbar}) == 0 } @tags_all; @posts = map { my $subject = $_; my @et = grep { my $subj = $_; grep { $subj eq $_ } @tags_all } @{$subject->{tags}}; @et = grep { $_ ne $aclselected } @et; $_->{extra_tags} = \@et; $_ } @posts; my @et = List::MoreUtils::singleton(@$tags, @tags_all); my $content = $processor->render('posts.tx', { acls => \@acls, can_edit => $is_admin, forms => $forms, post => { tags => $tags, extra_tags => \@et, form => $edittype, visibility => $user_visibility, addpost => 1 }, post_visibilities => \@visibuddies, failure => $query->{failure}, to => $query->{to}, message => $query->{failure} ? "Failed to add post!" : "Successfully added Post as $query->{id}", direct => $direct, title => $query->{title}, style => $query->{style}, posts => \@posts, like => $query->{like}, in_series => exists $query->{in_series} || !!($query->{route} =~ m/^\/series\//), route => $query->{route}, limit => $limit, pages => scalar(@posts) == $limit, older => $older, sizes => [25,50,100], rss => !$query->{id} && !$query->{older}, tiled => $tiled, category => $ph, subhead => $query->{subhead}, header => $header, footer => $footer, headers => $headers, footers => $footers, years => [reverse($oldest_year..$now_year)], months => [0..11], }); return $content if $direct; return Trog::Routes::HTML::index($query, $render_cb, $content, $styles); } sub _templates_in_dir($path) { my $forms = []; opendir(my $dh, $path); while (my $form = readdir($dh)) { push(@$forms, $form) if -f "$path/$form" && $form =~ m/.*\.tx$/; } close($dh); return $forms; } sub _themed_title ($path) { return $path unless %Theme::paths; return $Theme::paths{$path} ? $Theme::paths{$path} : $path; } sub _post_helper ($query, $tags, $acls) { state $data = Trog::Data->new($conf); return $data->get( older => $query->{older}, page => int($query->{page} || 1), limit => int($query->{limit} || 25), tags => $tags, exclude_tags => $query->{exclude_tags}, acls => $acls, aclname => $query->{aclname}, like => $query->{like}, author => $query->{author}, id => $query->{id}, version => $query->{version}, ); } =head2 sitemap Return the sitemap index unless the static or a set of dynamic routes is requested. We have a maximum of 99,990,000 posts we can make under this model As we have 10,000 * 10,000 posts which are indexable via the sitemap format. 1 top level index slot (10k posts) is taken by our static routes, the rest will be /posts. Passing ?xml=1 will result in an appropriate sitemap.xml instead. This is used to generate the static sitemaps as expected by search engines. Passing compressed=1 will gzip the output. =cut sub sitemap ($query, $render_cb) { my (@to_map, $is_index, $route_type); my $warning = ''; $query->{map} //= ''; if ($query->{map} eq 'static') { # Return the map of static routes $route_type = 'Static Routes'; @to_map = grep { !defined $routes{$_}->{captures} && $_ !~ m/^default|login|auth$/ && !$routes{$_}->{auth} } keys(%routes); } elsif ( !$query->{map} ) { # Return the index instead @to_map = ('static'); my $data = Trog::Data->new($conf); my $tot = $data->count(); my $size = 50000; my $pages = int($tot / $size) + (($tot % $size) ? 1 : 0); # Truncate pages at 10k due to standard my $clamped = $pages > 49999 ? 49999 : $pages; $warning = "More posts than possible to represent in sitemaps & index! Old posts have been truncated." if $pages > 49999; foreach my $page ($clamped..1) { push(@to_map, "$page"); } $is_index = 1; } else { $route_type = "Posts: Page $query->{map}"; # Return the map of the particular range of dynamic posts $query->{limit} = 50000; $query->{page} = $query->{map}; @to_map = _post_helper($query, [], ['public']); } if ( $query->{xml} ) { my $sm; my $xml_date = time(); my $fmt = "xml"; $fmt .= ".gz" if $query->{compressed}; if ( !$query->{map}) { require WWW::SitemapIndex::XML; $sm = WWW::SitemapIndex::XML->new(); foreach my $url (@to_map) { $sm->add( loc => "http://$query->{domain}/sitemap/$url.$fmt", lastmod => $xml_date, ); } } else { require WWW::Sitemap::XML; $sm = WWW::Sitemap::XML->new(); my $changefreq = $query->{map} eq 'static' ? 'monthly' : 'daily'; foreach my $url (@to_map) { my $true_uri = "http://$query->{domain}$url"; if (ref $url eq 'HASH') { my $is_user_page = grep { $_ eq 'about' } @{$url->{tags}}; $true_uri = "http://$query->{domain}/posts/$url->{id}"; $true_uri = "http://$query->{domain}/users/$url->{title}" if $is_user_page; } my %data = ( loc => $true_uri, lastmod => $xml_date, mobile => 1, changefreq => $changefreq, priority => 1.0, ); if (ref $url eq 'HASH') { #add video & preview image if applicable $data{images} = [{ loc => "http://$query->{domain}$url->{href}", caption => $url->{data}, title => substr($url->{title},0,100), }] if $url->{is_image}; # Truncate descriptions my $desc = substr($url->{data},0,2048); $desc //= ''; $data{videos} = [{ content_loc => "http://$query->{domain}$url->{href}", thumbnail_loc => "http://$query->{domain}$url->{preview}", title => substr($url->{title},0,100), description => $desc, }] if $url->{is_video}; } $sm->add(%data); } } my $xml = $sm->as_xml(); require IO::String; my $buf = IO::String->new(); my $ct = 'application/xml'; $xml->toFH($buf, 0); seek $buf, 0, 0; if ($query->{compressed}) { require IO::Compress::Gzip; my $compressed = IO::String->new(); IO::Compress::Gzip::gzip($buf => $compressed); $ct = 'application/gzip'; $buf = $compressed; seek $compressed, 0, 0; } return [200,["Content-type" => $ct], $buf]; } @to_map = sort @to_map unless $is_index; my $processor = Text::Xslate->new( path => _dir_for_resource('sitemap.tx'), ); my $styles = _build_themed_styles('sitemap.css'); $query->{title} = "$query->{domain} : Sitemap"; my $content = $processor->render('sitemap.tx', { title => "Site Map", to_map => \@to_map, is_index => $is_index, route_type => $route_type, route => $query->{route}, }); return Trog::Routes::HTML::index($query, $render_cb,$content,$styles); } sub _rss ($query,$posts) { require XML::RSS; my $rss = XML::RSS->new (version => '2.0'); my $now = DateTime->from_epoch(epoch => time()); $rss->channel( title => "$query->{domain}", link => "http://$query->{domain}/$query->{route}?format=rss", language => 'en', #TODO localization description => "$query->{domain} : $query->{route}", pubDate => $now, lastBuildDate => $now, ); #TODO configurability $rss->image( title => $query->{domain}, url => "$td/img/icon/favicon.ico", link => "http://$query->{domain}", width => 88, height => 31, description => "$query->{domain} favicon", ); foreach my $post (@$posts) { my $url = "http://$query->{domain}$post->{local_href}"; _post2rss($rss,$url,$post); next unless ref $post->{aliases} eq 'ARRAY'; foreach my $alias (@{$post->{aliases}}) { $url = "http://$query->{domain}$alias"; _post2rss($rss,$url,$post); } } require Encode; return [200, ["Content-type" => "application/rss+xml"], [Encode::encode_utf8($rss->as_string)]]; } sub _post2rss ($rss,$url,$post) { $rss->add_item( title => $post->{title}, permaLink => $url, link => $url, enclosure => { url => $url, type=>"text/html" }, description => "{data}]]>", pubDate => DateTime->from_epoch(epoch => $post->{created} ), #TODO format like Thu, 23 Aug 1999 07:00:00 GMT author => $post->{user}, #TODO translate to "email (user)" format ); } =head2 manual Implements the /manual and /lib/* routes. Basically a thin wrapper around Pod::Html. =cut sub manual ($query, $render_cb) { require Pod::Html; require Capture::Tiny; return forbidden($query, $render_cb) unless grep { $_ eq 'admin' } @{$query->{acls}}; #Fix links from Pod::HTML $query->{module} =~ s/\.html$//g if $query->{module}; my $infile = $query->{module} ? "$query->{module}.pm" : 'tCMS/Manual.pod'; return notfound($query,$render_cb) unless -f "lib/$infile"; my $content = capture { Pod::Html::pod2html(qw{--podpath=lib --podroot=.},"--infile=lib/$infile") }; my @series = _get_series(1); return $render_cb->('manual.tx', { title => 'tCMS Manual', theme_dir => $td, content => $content, categories => \@series, stylesheets => _build_themed_styles('post.css'), }); } # Deal with Params which may or may not be arrays sub _coerce_array ($param) { my $p = $param || []; $p = [$param] if $param && (ref $param ne 'ARRAY'); return $p; } sub _build_themed_styles ($style) { my @styles; @styles = ("/styles/$style") if -f "www/styles/$style"; my $ts = _themed_style($style); push(@styles, $ts) if $theme_dir && -f "www/$ts"; return \@styles; } sub _build_themed_scripts ($script) { my @scripts = ("/scripts/$script"); my $ts = _themed_script($script); push(@scripts, $ts) if $theme_dir && -f "www/$ts"; return \@scripts; } sub _build_themed_templates ($template) { my @templates = ("/templates/$template"); my $ts = _themed_template($template); push(@templates, $ts) if $theme_dir && -f "www/$ts"; return \@templates; } sub _pick_processor($file, $normal, $themed) { return _dir_for_resource($file) eq $template_dir ? $normal : $themed; } # Pick appropriate dir based on whether theme override exists sub _dir_for_resource ($resource) { return $theme_dir && -f "www/$theme_dir/$resource" ? $theme_dir : $template_dir; } sub _themed_style ($resource) { return _dir_for_resource("styles/$resource")."/styles/$resource"; } sub _themed_script ($resource) { return _dir_for_resource("scripts/$resource")."/scripts/$resource"; } sub _themed_template ($resource) { return _dir_for_resource("templates/$resource")."/templates/$resource"; } 1;