Re: SV: [MacPerl-AnyPerl] exchanging data (again)

[Thomas Wegner <toms_email@gmx.de>]

>thanks for the reply!
>
>just to clear things up:
>i have a about 1000 lines long html file where there occour a table with
>something like these table rows:
>
><tr><td>ABC</td><td>111.09</td>222.00<td>333.89</td></tr>
><tr><td>DEFG</td><td>444.44</td>555.67<td>nothing</td></tr>
><tr><td>HIJ</td><td>666.99</td>empty<td>empty</td></tr>
>
>
>all the figures need to be replaced from a txt-file that will look like this
>when transformed and colon-seperated:
>
>ABC:777.77:888.88:999.99
>DEFG:111.11:222.22
>HIJ:666.66
>
>
>so my new html-file (which should be a plain new html (or txt - it doesn
>really matter) file so i can compare it with the original)should look like:
>
><tr><td>ABC</td><td>777.77</td>888.88<td>999.99</td></tr>
><tr><td>DEFG</td><td>111.11:</td>222.22<td>nothing</td></tr>
><tr><td>HIJ</td><td>666.66</td>empty<td>empty</td></tr>
>
>so there is a pattern for the replacement ...
>
>
>hope this clear things up
>
>i´m working on my own perl-construct but would still really like to see how
>it should be done
>thanks again
>allan
>

Dear Allan,

I really don't know "how it should be done", but as always: "There's 
more than one way to do it" :-).  A simple way  would be to put all 
the substitutes from the colon-separated text file into an array. 
Each of the entries could easily be splitted into a pattern and a 
data part. The patterns could then be used to match (and substitute) 
the corresponding lines.

The following script is only an idea how it could be done. It 
assumes, that the order of the pattern/data entries in the text file 
corresponds with the order of the lines you are looking for in your 
HTML file (which greatly simplifies things). It also assumes, that 
the whole table row is on one line, as in your example. All 
non-matched lines will be written unchanged to the new HTML file. 
The search and substitution patterns will be changed after each 
matched (and substituted) line. After the last match has been done, 
all remaining lines are written unchanged to the new file. So :

_______________
#!perl -w

    use strict;

    my $old = "file.html";
    my $new = "file.html.tmp";
    my $bak = "file.html.bak";

    my $sub_file = "sub_file.txt";

    open(SUBFILE, "< $sub_file") or die "Cannot open $sub_file: $!";
    my @substitutes = <SUBFILE>;
    close(SUBFILE);
    chomp(@substitutes); # get rid off newlines

    open(OLD, "< $old") or die "Cannot open $old: $!";
    open(NEW, "> $new") or die "Cannot open $new: $!";

    my $tab_columns = 3; # max columns of your table
    my $empty = ' '; # a space, used for trimming

    foreach my $substitution (@substitutes) { # iterate over @substitutes array
        my ($pattern, @data) = split (/:/, $substitution);
        while ( scalar(@data) < $tab_columns ) {push (@data, $empty)}
           # trim @data array with $empty entries, if necessary

        my $match_pattern = 
"<tr><td>$pattern</td><td>[^<>]+</td><td>[^<>]+</td><td>[^<>]+</td></tr>";
           # [^<>]+ matches anything except '<' and '>' one or more 
times, hope this will do the job
        my $sub_pattern = 
"<tr><td>$pattern</td><td>$data[0]</td><td>$data[1]</td><td>$data[2]</td></tr>";

        while (<OLD>) {
            my $match = s|$match_pattern|$sub_pattern|i; # 
case-insensitive pattern matching
            print NEW $_; # write the line to new file
            last if $match; # exit while if match
        }#while
   }#for

    while (<OLD>) { # print remaining lines after last match
          print NEW $_; # write the line to new file
    }#while

    close(OLD);
    close(NEW);

    # rename OLDNAME,NEWNAME
    rename($old, $bak) or die "Cannot rename $old to $bak: $!";
    rename($new, $old) or die "Cannot rename $new to $old: $!";
_______________
The script hasn't been tested much. You have been warned.

Hope that helps.

Best regards

--Thomas


==== Want to unsubscribe from this list?
==== Send mail with body "unsubscribe" to macperl-anyperl-request@macperl.org