package Display::Markup; use strict; use warnings; use base qw(Exporter); our @EXPORT_OK = qw(line_parse image_markup gallery); use File::Basename; use Display::Image qw(image_size gallery); use Text::Textile; # Some useful defaults: my %tags = ( retcon => q{div class="retcon"}, freeverse => 'p', list => "ul>\n 'div', freeverse => 'p', list => "li>\n "

\n\n

", list => "\n\n

  • " ); my %newlines = ( freeverse => "
    \n" ); my %dashes = ( freeverse => ' — ' ); =item line_parse Performs substitutions on lines called by fragment_slurp, at least. Calls image_markup, Text::Textile, Wala::wiki_page_to_html, eval_perl. Returns string. Parses some special markup, specifically: embedded perl ${variable} interpolation from %DISPLAY_CONF - Text::Textile to HTML - Wala::wikify(); directory_name filename.ext optional alt tag =cut sub line_parse { my $self = shift; my ($everything, $file) = (@_); # Take care of , , , and tags: #$everything =~ s/(.*?)<\/wala>/Wala::wikify($1)/seg; textile_process($everything); $everything =~ s!(.*?)!$self->gallery_markup($file, $1)!seg; $everything =~ s!(.*?)!$self->image_markup($file, $1)!seg; foreach my $key (keys %tags) { # Set some replacements, unless they've been explicitly set already: $end_tags{$key} ||= $tags{$key}; $blank_lines{$key} ||= "\n\n"; $newlines{$key} ||= "\n"; $dashes{$key} ||= " -- "; # Transform blocks: while ($everything =~ m/(<$key>.*?<\/$key>)/s) { my $block = $1; # Save the bits between instances of the block: my (@interstices) = split /\Q$block\E/s, $everything; # Tags that surround the block: $block =~ s{\n?<$key>\n?}{<$tags{$key}>}gs; $block =~ s{\n?\n?}{}gs; # Dashes, blank lines, and newlines: $block = dashes($dashes{$key}, $block); $block =~ s/\n\n/$blank_lines{$key}/gs; $block = newlines($newlines{$key}, $block); # ...and slap it all back together as $everything $everything = join $block, @interstices; } } return $everything; } sub newlines { my ($replacement, $block) = @_; # Single newlines (i.e., line ends) within the block, # except those preceded by a double-quote, which probably # indicates a still-open tag: $block =~ s/(?<=[^"\n]) # not a double-quote or newline # don't capture \n # end-of-line (?=[^\n]) # not a newline # don't capture /$replacement/xgs; return $block; } # might need a rewrite. sub dashes { my ($replacement, $block) =@_; $block =~ s/(\s+) # whitespace - no capture \-{2} # two dashes (\n|\s+|$) # newline, whitespace, or eol /$1${replacement}$2/xgs; return $block; } =item textile_process Inline replace markup in a string. Trying to implement some caching here, though it's questionable whether this makes any sense. There's also a closure which should retain the Text::Textile object between invocations, potentially saving some time at the expense of a little memory. =cut { my %cache; my $textile; sub textile_process { my $replacement; unless (defined $textile) { # head_offset: use h1., h2. in Textile formatting: $textile = Text::Textile->new( head_offset => 2 ); } while ( $_[0] =~ m/(.*?)<\/textile>/sx ) { my $block = $1; if (exists $cache{$block}) { $replacement = $cache{$block}; } else { $replacement = $textile->process($block); $cache{$block} = $replacement; } $_[0] =~ s/\Q$block\E<\/textile>/$replacement/sg; } return; } } =item image_markup Parse out an image tag and return the appropriate html. Relies on image_size from Display::Image. =cut sub image_markup { my $self = shift; my ($file, $block) = @_; # Get a basename and directory for the file referencing the image: my ($basename, $dir) = fileparse($file); # Truncated file date that just includes date + sub docs: my ($file_date) = $dir =~ m{([0-9]{4}/ # year [0-9]{1,2}/ # month [0-9]{1,2}/ # day ([a-z]*/)*)$ # sub-entries }x; # Process the contents of the tag: my ($image_url, $alt_text, $title_text) = split /\n/, $block; $alt_text ||= q{}; $title_text ||= $alt_text; # Resolve relative paths: my $image_file; if (-e "$dir/$image_url" ) { $image_file = "$dir/$image_url"; $image_url = "${file_date}${image_url}"; } elsif (-e $self->root_dir . "/$image_url") { $image_file = $self->root_dir . "/$image_url"; } # Get width & height in pixels for known filetypes: my ($width, $height) = image_size($image_file); # This probably relies on mod_rewrite working: $image_url = $self->image_url_root . $image_url; return <<"IMG"; $alt_text IMG } =item gallery_markup Generate a gallery of images. =cut sub gallery_markup { my $self = shift; my ($file, $block) = @_; my ($dir, $basedir) = fileparse($file); if (-d "$basedir/$file") { return gallery("$basedir/$file", ""); } } # Encapsulate some ugly file-location functionality. sub resolve_file { } 1;