Add HTML to List Using Perl

July 12, 2019July 12, 2019 Dave 0 Comments coding, html, Perl, programming, scripting

As we write articles we create lists and then add HTML. Adding HTML by hand is boring. Adding HTML with a GUI editor often leaves all kinds of junk in your HTML code. If you want to wrap simple list item tags around a text list, Perl can do that for you.

This is a rather mundane use case for Tk and Perl, but the concept could be applied to all sorts of CLI activities too. Basically you are looping over each line and adding something to the front and the back of that line.

We share this as a demo of how to create a Perl Text Processor in Tk. Tk itself is rather venerable, but it works!

Topics to Learn:

Look at the image, it shows this exact list and that is because we used the program to make the HTML for this article.

Tk Framings Pack
OS Detection
Hide TK Console
Constants
Create Buttons in Tk
Delete Textarea in Tk
Simple Regex
Perl Subroutines
Perl for loops

Perl Source Code to Wrap Front and Back of Each Line with HTML

#!/usr/bin/perl

use warnings;
use strict;
use Tk;

# hide the console, if windows
BEGIN {
    if ( $^O eq 'MSWin32' ) {
        require Win32::Console;
        Win32::Console::Free();
    }
}

use constant VERSION => '1.0';

# new window
my $g = MainWindow->new;

# title bar of main window
$g->title( "HTML LIST " . VERSION );

# define window size (resizable later via mouse, w x h)
$g->geometry("950x700");

# setup some frames in the main window
# the main frame
my $mF =
  $g->Frame( -background => "red" )->pack( -side => 'top', -fill => 'x' );

# input section
my $in =
  $mF->Frame( -borderwidth => '1' )->pack( -side => "top", -fill => 'x' );
my $inLabel = $in->Label( -text => "Input List:" )->pack( -side => "top" );
my $inBody = $in->Text(
    -background  => 'white',
    -foreground  => 'black',
    -height      => '20',
    -width       => "120",
    -borderwidth => '1'
)->pack( -side => "top" );

# command section has buttons in it
my $commands =
  $mF->Frame( -borderwidth => '1' )->pack( -side => "top", -fill => 'x' );
my $command = $commands->Button(
    -text    => "Create HTML",
    -command => \&process
)->pack( -side => "left" );
my $clearcmd = $commands->Button(
    -text    => "Clear Everything",
    -command => \&clear
)->pack( -side => "left" );

# output section is at the bottom with a simple label
my $out = $mF->Frame( -borderwidth => '1' )->pack(
    -side => "top",
    -fill => 'x'
);
my $outLabel = $out->Label( -text => "HTML Output:" )->pack( -side => "top" );
my $outBody = $out->Text(
    -background  => 'white',
    -foreground  => 'black',
    -height      => '22',
    -width       => "120",
    -borderwidth => '1'
)->pack( -side => "top" );

# stop building TK widgets, the rest is subroutines, run it
MainLoop;

# not used currently
sub clear {
    $inBody->delete( '0.0', 'end' );
    $outBody->delete( '0.0', 'end' );
}

# try to consolidate regex to keep things clean
sub onespace {
    my $data = shift;
    $data =~ s#\s+# #g;    # remove one or more white spaces (globally)
    return $data;
}

sub trimspace {
    my $data = shift;
    $data =~ s#^\s+##;     # if we wanted to trim only the front \s
    $data =~ s#\s+$##;     # if we wanted to trim only the back \s;
    return $data;
}

# loop over the input text and process, return output
# this is much longer than one screen best practices,
# possibly should be broken into more subs
sub process {

    # clear existing script to avoid confusion
    $outBody->delete( '0.0', 'end' );

    # get the entire block of text, process later
    my $input = $inBody->get( '1.0', 'end' );

    # convert to list
    my @input = split( /\n/, $input );

    # massage data
    $input = trimspace($input);
    $input = onespace($input);

    $outBody->insert( 'end', "\<ul\>\n" );

    foreach my $line (@input) {

        # if it's not a literal . or A-Za-z0-9, etc, replace as a space
        $line =~ s/[^\w\.\!\$\%\&\_\-\+\=\'\:\?\,\/\\]{1}/ /ig;
        $line = trimspace($line);
        $outBody->insert( 'end', "\<li\>$line\<\/li\>\n" );
    }

    $outBody->insert( 'end', "\<\/ul\>\n" );
}

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

#!/usr/bin/perl

use warnings;

use strict;

use Tk;

# hide the console, if windows

BEGIN {

if ( $^O eq 'MSWin32' ) {

require Win32::Console;

Win32::Console::Free();

}

use constant VERSION => '1.0';

# new window

my $g = MainWindow->new;

# title bar of main window

$g->title( "HTML LIST " . VERSION );

# define window size (resizable later via mouse, w x h)

$g->geometry("950x700");

# setup some frames in the main window

# the main frame

my $mF =

$g->Frame( -background => "red" )->pack( -side => 'top', -fill => 'x' );

# input section

my $in =

$mF->Frame( -borderwidth => '1' )->pack( -side => "top", -fill => 'x' );

my $inLabel = $in->Label( -text => "Input List:" )->pack( -side => "top" );

my $inBody = $in->Text(

-background => 'white',

-foreground => 'black',

-height => '20',

-width => "120",

-borderwidth => '1'

)->pack( -side => "top" );

# command section has buttons in it

my $commands =

$mF->Frame( -borderwidth => '1' )->pack( -side => "top", -fill => 'x' );

my $command = $commands->Button(

-text => "Create HTML",

-command => \&process

)->pack( -side => "left" );

my $clearcmd = $commands->Button(

-text => "Clear Everything",

-command => \&clear

)->pack( -side => "left" );

# output section is at the bottom with a simple label

my $out = $mF->Frame( -borderwidth => '1' )->pack(

-side => "top",

-fill => 'x'

);

my $outLabel = $out->Label( -text => "HTML Output:" )->pack( -side => "top" );

my $outBody = $out->Text(

-background => 'white',

-foreground => 'black',

-height => '22',

-width => "120",

-borderwidth => '1'

)->pack( -side => "top" );

# stop building TK widgets, the rest is subroutines, run it

MainLoop;

# not used currently

sub clear {

$inBody->delete( '0.0', 'end' );

$outBody->delete( '0.0', 'end' );

}

# try to consolidate regex to keep things clean

sub onespace {

my $data = shift;

$data =~ s#\s+# #g; # remove one or more white spaces (globally)

return $data;

}

sub trimspace {

my $data = shift;

$data =~ s#^\s+##; # if we wanted to trim only the front \s

$data =~ s#\s+$##; # if we wanted to trim only the back \s;

return $data;

}

# loop over the input text and process, return output

# this is much longer than one screen best practices,

# possibly should be broken into more subs

sub process {

# clear existing script to avoid confusion

$outBody->delete( '0.0', 'end' );

# get the entire block of text, process later

my $input = $inBody->get( '1.0', 'end' );

# convert to list

my @input = split( /\n/, $input );

# massage data

$input = trimspace($input);

$input = onespace($input);

$outBody->insert( 'end', "\<ul\>\n" );

foreach my $line (@input) {

# if it's not a literal . or A-Za-z0-9, etc, replace as a space

$line =~ s/[^\w\.\!\$\%\&\_\-\+\=\'\:\?\,\/\\]{1}/ /ig;

$line = trimspace($line);

$outBody->insert( 'end', "\<li\>$line\<\/li\>\n" );

}

$outBody->insert( 'end', "\<\/ul\>\n" );

}

Ruby Sash Consulting

Add HTML to List Using Perl

Topics to Learn:

Perl Source Code to Wrap Front and Back of Each Line with HTML

Leave a Reply Cancel reply