Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?

Re: Where to put self-made loop logic (separate module)?

by davido (Archbishop)
on Dec 29, 2012 at 00:05 UTC ( #1010767=note: print w/replies, xml ) Need Help??

in reply to Where to put self-made loop logic (separate module)?

Show what you've come up with so far. If it's compelling enough, and can be generalized enough, it might be a reasonable candidate for addition to a module that houses a bunch of useful and similar utilities, such as List::EVENMoreUtils (j/k about the name).

It doesn't sound like something that comprises a large amount of code, so let's have a look at it.


  • Comment on Re: Where to put self-made loop logic (separate module)?

Replies are listed 'Best First'.
Re^2: Where to put self-made loop logic (separate module)?
by basic6 (Novice) on Dec 30, 2012 at 16:07 UTC
    Wow, so many answers already. :-)

    The best way to find out if this should be a separate module is probably to let you guys decide, so here's the code...
    This code parses some special list markup (similar to Wiki markup).
    The scalarref ($text) is directly modified (I don't want to copy it and go $$text = $newtext).
    If I wanted to write another parser function which does even more complicated modifications (which cannot be replaced by a regex), I'd have some duplicate code if this loop was not a separate module.
    I know this isn't the prettiest piece of code mankind has written, but it seems to work (even with 3 byte UTF-8 characters / note that the line length changes).
    I'd be happy if you could help me improve my code (even if there's a one-line alternative).

    sub parseLists { my $self = shift; my $text = \$self->{_text}; # So we want to loop through the text line by line # and be able to modify some lines, # but we don't want to rebuild/copy the whole text. my $lf = "\n"; # linebreak my $lflen = length $lf; # 1 my $pos1 = 0; # left line offset my $pos2 = 0; # right line offset (1st char after line) my $len = 0; # line length my $lendif = 0; # line length difference my $inlist; open my $fh, "<:utf8", $text; # Note how we open in UTF-8 mode # while (<$fh>) # Gets confused when line length changes # Using seek() is risky, because it reads bytes, not chars! # However, substr() always counts chars, not bytes. while (<$fh>) { # Get line string without newline character my $line = substr $_, 0, -$lflen; my $oldline = $line; # Calculate offsets $len = length $line; $pos1 = $pos2; $pos2 += $len + $lflen; # Modify line # START (not part of loop structure) my $isasterisk = $line =~ m/^\* /; my $isindented = $line =~ m/^\ /; my $isfirst; if (!$inlist) { if ($isasterisk) { $isfirst = 1; $inlist = 1; } } if ($inlist) { if (!$isindented && !$isasterisk) { substr $line, 0, 0, "</ul>\n"; $inlist = 0; } elsif ($isindented) { $line =~ s/^\ (.*)/<li class="nobullet">$1<\/li>/; } elsif ($isasterisk) { $line =~ s/^\* (.*)/<li>$1<\/li>/; substr $line, 0, 0, "<ul>\n" if $isfirst; } } # END # Write new line back substr $$text, $pos1, $len, $line; # Calculate diff $lendif = (length $line) - ((length $_) - ($lflen)); # Adjust our and Perl's (!) position counter $pos2 += $lendif; # That's our counter seek $fh, $lendif, 1; # That's from Perl / SEEK_CUR } }

      Does the format of the input data have a name? Is the input data format documented somewhere?


        The input is (part of) a template. In other words, it's just human-readable text, no code (no Perl, no HTML). There may be a couple of lines, each starting with an asterisk - that's what my function parses.
        But that's probably not important, as my goal is to have a line-by-line loop structure which allows in-place modifications. For that matter, the input is guaranteed to always be UTF-8 encoded text (only printable characters and whitespaces).

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1010767]
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (6)
As of 2018-06-24 00:22 GMT
Find Nodes?
    Voting Booth?
    Should cpanminus be part of the standard Perl release?

    Results (126 votes). Check out past polls.