Idiomize This - Cleanup/Transform

[johnr]

Hello, I have this sub that seems way too long. It loops through a data file with pipe separated values and removes unwanted stuff and transforms values into standard format used elsewhere in application.

I have another one of these subroutines (in another module) that gets html as input and iterates HTML::TableExtract output in the foreach lop.

sub get_state {
    my ($self, $contents) = @_;

    $contents =~ s/\r//g;
    
    my %session = ();

    foreach (split /\n/, $contents) {

     if (/^ *\d+\+*\|/) {
            # Data record
        my @values = split(/\|/);
        foreach (@values) { s/^\ *//; };

        my %stats;
        @stats{@{$self->{fields}}} = @values;

        # do some clean up / bring to common values

        $stats{position} =~ s/\+//g;  # sometimes there is a "+"

        $stats{driver} =~ s/ *\(R\)$//; # I don't care if rookie

        $stats{best_speed} =~ s/\+//g;  # sometimes there is a "+" at 
+end

        if ($stats{status} eq '') { # not all the series track run, pi
+t, etc
            $stats{status} = 'Run'
        }

        $stats{status} =~ s/In Pit/Pit/ig;
        $stats{status} =~ s/Active/Run/;
        $stats{status} =~ s/Pace_Laps/Pace/;

        # convert time from MM:SS to seconds
        $stats{last_lap} = $self->time_to_dec($stats{last_lap});
        $stats{best_lap} = $self->time_to_dec($stats{best_lap});

        $stats{id} = $stats{car};

        #Logger->log(Dumper(%stats));

        push @{$session{positions}}, \%stats;

    } elsif (/^</) {
        # Header
        my @values = split(/\|/);

        my $flag;
            my $abbrv = $values[5];
        if ($abbrv eq 'G') { 
            $flag = 'Green'
            } elsif ($abbrv eq 'Y') {
                $flag = 'Yellow'
            } elsif ($abbrv eq 'R') {
                $flag = 'Red'
            } elsif ($abbrv eq 'C') {
                $flag = 'Checkered'
            } elsif ($abbrv eq 'U') {
                $flag = 'Unflagged'
            } else {
                $flag = "$abbrv";
            }
        if ($abbrv ne '') { $session{flag} = $flag };

        my $msg = $values[16];
            $msg =~ s/^>//;
        $msg =~ s/^.* : //;

        $session{control_message} = $msg unless $msg =~ /^\S+ flag/i;
        $session{event} = $values[0];
        $session{event} =~ s/\<\!(.*)/$1/;
        
        } else {
        #print "garbage: $_\n";
        }
    }

    Logger->log("series: |$session{series}| event: |$session{event}| f
+lag: |$session{flag}| time: |$session{time}|");

    return %session;
}

It seems like there should be a framework or something to do this kind of task. If not that, than some way to be more concise yet still clear in intent. It may be I am am trying to do a lot and this is what it takes.

Feel free to provide me name of some high level concept that I can research further.

Thanks, John

[choroba]

There is not really much you can idiomize, if you show all the code you want to change. But you can take inspiration from the following (untested):
Read more... (3 kB)

[johnr]

Thanks both you...and yes, that is the inspiration (and more) that I needed! John

[tobyink]

You didn't provide any example data for testing, so I can't guarantee that the following actually works. It does compile though.

my %abbreviations = (
    G  => 'Green',
    Y  => 'Yellow',
    R  => 'Red',
    C  => 'Checkered',
    U  => 'Unflagged',
    );

my @cleanups = (
    [ position   => qr{\+}, undef, 'g' ], # sometimes there is a "+"
    [ driver     => qr{\s*\(R\)$}      ], # I don't care if rookie
    [ best_speed => qr{\+}, undef, 'g' ], # sometimes there is a "+" a
+t end
    [ status     => qr{\A\z}, 'Run' ], # not all the series track run,
+ pit, etc
    [ status     => qr{In Pit}i, 'Pit' ],
    [ status     => qr{Active}i, 'Run' ],
    [ status     => qr{Pace_Laps}i, 'Pace' ],
    );

sub get_state {
    my ($self, $contents) = @_;

    $contents =~ s/\r//g;

    my %session = ();

    foreach (split /\n/, $contents) {
        if (/^ \s* \d+ [+]* [|] /x) {
            # Data record
            my %stats;
            @stats{@{$self->{fields}}} = map { s/^\s*// } split /\|/;

            foreach my $cleanup (@cleanups) {
                my ($key, $match, $replace, $global) = @$cleanup;
                
                $global ? ( $stats{$key} =~ s/$match/$replace/g )
                        : ( $stats{$key} =~ s/$match/$replace/ )
            }

            # convert time from MM:SS to seconds
            $stats{$_} = $self->time_to_dec($stats{$_}) for qw(last_la
+p best_lap);

            $stats{id} = $stats{car};

            #Logger->log(Dumper(%stats));

            push @{$session{positions}}, \%stats;
        }
        
        elsif (/^</) {
            # Header
            my @values = split(/\|/);

            my $abbrv = $values[5];
            $session{flag} = $abbreviations{$abbrv} // $abbrv
                unless $abbrv eq '';

            my $msg = $values[16];
            $msg =~ s/^>//;
            $msg =~ s/^.* : //;

            $session{control_message} = $msg unless $msg =~ /^\S+ flag
+/i;
            $session{event} = $values[0];
            $session{event} =~ s/\<\!(.*)/$1/;
        }
        
        else {
            #print "garbage: $_\n";
        }
    }

    Logger->log("series: |$session{series}| event: |$session{event}| f
+lag: |$session{flag}| time: |$session{time}|");

    return %session;
}

[Anonymous Monk]

schwern would turn each if/else block into a function. See his slideshow about this skimmable code where he tackles refactoring WWW::Mechanize, and the shorter version of the skimmable code talk, in the longer version he subliminally introduces Method::Signatures

[johnr]

Thanks for the presentations. The skimmable one especially helps. I will do some refactoring passes that combine suggestions. Further benefit of pulling out the conditions into hashes/arrays of hashes is that I can move those bits into my config file.

[jwkrahn]

Here is my two cents worth:

my %abbrev = (
    G => 'Green',
    Y => 'Yellow',
    R => 'Red',
    C => 'Checkered',
    U => 'Unflagged',
    );

sub get_state {
    my ( $self, $contents ) = @_;
    $contents =~ tr/\r//d;
    my %session;
    for ( split /\n/, $contents ) {
        if ( /^ *\d+\+*\|/ ) {
            # Data record
            my @values = split /\|/, $_, -1;
            s/^ *// for @values;
            my %stats;
            @stats{ @{ $self->{ fields } } } = @values;
            # do some clean up / bring to common values
            $stats{ position } =~ tr/+//d;    # sometimes there is a "
++"
            $stats{ best_speed } =~ tr/+//d;  # sometimes there is a "
++" at end
            $stats{ driver } =~ s/ *\(R\)$//; # I don't care if rookie
            unless ( length $stats{ status } ) {   # not all the serie
+s track run, pit, etc
                $stats{ status } = 'Run'
                }
            $stats{ status } =~ s/In Pit/Pit/ig;
            $stats{ status } =~ s/Active/Run/;
            $stats{ status } =~ s/Pace_Laps/Pace/;
            # convert time from MM:SS to seconds
            $stats{ last_lap } = $self->time_to_dec( $stats{ last_lap 
+} );
            $stats{ best_lap } = $self->time_to_dec( $stats{ best_lap 
+} );
            $stats{ id } = $stats{ car };
            #Logger->log( Dumper( %stats ) );
            push @{ $session{ positions } }, \%stats;
            }
        elsif ( /^</ ) {
            # Header
            my ( $event, $flag, $msg ) = ( split /\|/, $_, -1 )[ 0, 5,
+ 16 ];
            ( $session{ event } = $event ) =~ s/<!//;
            if ( length $flag ) {
                $session{ flag } = exists $abbrev{ $flag } ? $abbrev{ 
+$flag } : $flag;
                }
            $msg =~ s/^>?.* : //;
            $session{ control_message } = $msg if $msg !~ /^\S+ flag/i
+;
            }
        else {
            #print "garbage: $_\n";
            }
        }
    Logger->log( "series: |$session{series}| event: |$session{event}| 
+flag: |$session{flag}| time: |$session{time}|" );
    return %session;
    }