I was trying to parse a fixed delimited report. But the locations of the columns was not fixed. However there was a header, something like this:

Here     Be Many    Columns
-------- ---------- ---------
[download]

my @space_loc;
while ($line =~ / /g) {
  push @space_loc, pos($line);
}
[download]

• Say you got some variables stored in a hash: name=>value and whant to replace them in a text where they are used in a make-like form: $(VARIABLE)

  foreach (keys %global_variables) {
     $content =~ s/\$\($_\)/$global_variables{$_}/g;
  }
  [download]

• When you want to indent a part of text and calculated the indent already you might use:

  $content =~ s/\n/\n$indent /g;
  [download]

• Some really often used substitutions are the whitespace deletions: 1. All whitespaces: $line =~ s/\s+//g; 2. Only leading whitespaces: $line =~ s/^\s*//; 3. Only trailing whitespaces: $line =~ s/\s*$//;
• Say you got a GUI (in my case it was Gtk) and want to display some messages. In the preview window though only the first line shall be displayed, marking that more is available:

  $text =~ s/\n.*/ [more\.\.\.]/s;
  [download]

Update: Added the missing parens around VARIABLE

Regards...	Stefan
you begin bashing the string with a +42 regexp of confusion

#Block is the chunk of text, word is the 'hidden' word and sep is the 
+number of characters in the text between each word
        my ($block, $sep, $word)=@_;
                my @let = split //, $word;
                my $rep;
                my $i=1;

                 foreach my $l (@let) {$l = "(".$l.")(.{$sep})";$rep.=
+ '\u$'.$i++.'$'.$i++;};
                my $regexp2 = join "", @let;
                my $ev = '$block =~ '."s/$regexp2/$rep/i;";
#               print "Now scanning block with $regexp2 and replacemen
+t target $rep\n";
                return $block, $word if eval $ev;
[download]

---This is the original text----------------------------------------
m at times; this thread, like that of Ariadne, when once
unraveled will conduct one through a lab


---The ELS 'FNORD' is in capitals---------------------

mattimesthisthreadlikethatoFariadNewhenOnceunRaveleDwillconductonethro
+ughalab
[download]

BTW if there's an obviously better way to do this I'd be delighted to hear about it.

____________________
Jeremy
I didn't believe in evil until I dated it.

I only remember this vaguely, but a while back I had a co worker ask me to write a simple parser to parse a proxy-cache log entry, sort of similar to Apache logs... where entries could be:

• all alpha-numeric characters w/o any whitespace
• double-quoted alpha-numeric characters ( whitespaces allowed ) where a double-quote is escaped with another double-quote

He encountered problems because he was trying to separate out the fields using split. Obviously, since an entry can contain spaces if it's quoted, you couldn't really split()

So the approach I took was something like this:

    # untested... I'm sure this doesn't really work...
    while( $line =~ m{\G\s*(\[\w0-9]+|"(?:[\w0-9]|"")+")}g ) {
        do_something_with_match($1);
    }
[download]

something like that. come to think of it, it's probably not a good example... oh well. my $0.02

$text =~ s/\[([^\]]+)\]/parseLink($1)/eg;

sub parseLink {
    my $link = shift;
    my ($type, $title);
    ($type, $link, $title) = $link =~ m!(.+)://(.+)|(.+)!;
    $type ||= '';
    $title ||= $link;
    return makeLink($link, $title, $type);
}
[download]

    $file =~ s/^.*$startstring/$startstring/s;
    $file =~ s/$endstring.*$//s;
    $file =~ s/<[^>]*>/ /g;
[download]

map s/^\s//, @fields;
[download]

_____________________________________________________
Jeff[japhy]Pinyan: Perl, regex, and perl hacker.
s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;

fwiw, japhy, i was reading a couple of chapters of your book this past weekend, and found them to be quite lucid. quite an accomplishment, 'cause if i'm not in the right mood regexs give me headaches (grin).

seriously, it's nice work.

my($username1,$username2)=($username)x2;
$username1 =~ s/([a-z])([a-z]+)_([a-z])([a-z]+)\@.*/$1/g;
$username2 =~ s/([a-z])([a-z]+)_([a-z])([a-z]+)\@.*/$3/;
$username1 =~ tr/[a-z]/[A-Z]/;
$username2 =~ tr/[a-z]/[A-Z]/;
$username =~ s/([a-z])([a-z]+)_([a-z])([a-z]+)/$username1$2 $username2
+$4/;
[download]

This will break an apart an email addresss of the form: first_name@domain.whatever and change it into the form: First Name.

$username =~ s/([a-z])([a-z]+)_([a-z])([a-z]+)\@.*/uc($1).$2." ".uc($3
+).$4/ge;
[download]

I once had to work with mapping a lot of text data in a spreadsheet to keys in a database. The database tables were for products and the currencies they were sold in. Rather than doing a lot of very tedious (and error-prone) replacement of the text data with the database IDs, I chose to have Perl do it for me.

I exported the text from the spreadsheed into a tab-delimited file. I then wrote a Perl script that read the tables and created hashes for them with the key being the text name and the id being the value. Then, the script opened the text file and rewrote every line using a substitution. Here is the relevant snippet:

open FILE, '+< products.txt' or die $!;

my @lines = 
    map { s/^([^\t]+)\t(.*)/
        exists $product{$1} and exists $currency{$2}
            ? "$product{$1}\t$currency{$2}" 
            : "$1\t$2" /e; $_ } 
        <FILE>;

seek FILE, 0,0;
print FILE @lines;
truncate FILE, tell(FILE);
close FILE;
[download]

The text file was rather large and in about five minutes, I accomplished many hours of manual labor. I don't claim that this is terribly maintainable, but this was used to populate about four different lookup tables and then discarded.

Cheers,
Ovid

Update: I forgot to mention one little problem: I had gotten the columns reversed. Rather than messing around with the import function in the database, I did the following:

perl -pi.bak -e "s/(\d+)\t(\d+)/$2\t$1/" products.txt
[download]

Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.

And for /g, a thing to split up a block of text, preserving existing line breaks, but having a max line size:

print $1,"\n"
   while $text =~ /([^\n]{0,$max_line_size}})\n?/g;
[download]

And this thing which reads from a socket until I have an end-token on a line:

while ($sel->can_read) {
  sysread($fh, $buffer, 2048, length($buffer));
  next unless $buffer =~ /^(EOT|DONE)$/m;
  ....(process $buffer)
}
[download]

$/ = undef;
while (<>) {

    print "\n$ARGV\n", / (.+?) ^.*^ (.+?) \z/xms
}
[download]

$dtrx = qr/[Dd][Tt]=(\d{8}\.\d{6})/;
$/ = undef;
while (<>) {

  ($aa, $z) = /$dtrx          # get the first one
               (?:            # and maybe,
                 .*           # after maybe many lines,
                 ^.*? $dtrx   # the first one on the last line
               )?             #   that has one
              /mxs;
  $aa or next;
  $z ||= '';                  # or '' if no more

  print "$ARGV\t $aa -- $z\n";
}
[download]

if(m/(([0-9]+)-((?:jan|feb|mar|apr|may|jun|jul|aug|sep|oct|nov|dec))-(
+[0-9]+))\s+((?:0?[0-9]|1[0-9]|2[0-3]):[0-5][0-9]:[0-5][0-9].[0-9]{3})
+\s+(.*)\/(\d+.\d+.\d+.\d+)\/($lookingfor)\/(a).*/i) 
    {  

        ## Notes:
        # $1 = Whole Date (DD-MMM-YYYY)
        # $2 = Day (DD)
        # $3 = Month (MMM as text)
        # $4 = Year (YYYY)
        # $5 = Time (HH:MM:SS.sss)
        # $6 = Queries info stuff (is not used)
        # $7 = IP of requesting name server
        # $8 = what we look for ($lookingfor variable)
        # $9 = type of record (A/MX/CNAME)
}
[download]

sub Text2HTML {
    my $s = shift;
    my $p;
    my $m;
    my $r;
    my $mcd = new Text::DelimMatch '"';

    if ($s) {
    $s =~ s/&/&amp\;/g;
    $s =~ s/\\\'/&\#39\;/g;
    $s =~ s/</&lt\;/g;
    $s =~ s/>/&gt\;/g;
    $s =~ s/\.\.\./&hellip\;/g;
    $s =~ s/--/&mdash\;/g;
    while ($s =~ /\"/) {
        ($p,$m,$r) = $mcd->match($s);
        if ($m) {
        $m =~ /^\"(.*?)\"$/;
        $s = $p.'&ldquo;'.$1.'&rdquo;'.$r;
        }
    }
    }
    return $s;
}
[download]

hsm

   $n = 6345789;
   $n =~ s/\B/+/g;
   $t = eval $n; # 42

   $n = '634-5789';
   $n =~ s/\B/+/g;
   $t =  eval $n; # 32
[download]