Notes on a Refactor

I prefer to let sleeping dogs lie. There's old, bad code that could be improved, but there's no case to be rewriting old code unless there's a problem with it that breaks a thing. Call it Bug-Driven Development, if you will.

But every bug will have it's day, I suppose.

My lab does science, and in order to not do wasteful, expensive science on things not worthy of the time and money, we do quality assurance, and we display the output to show us and our clients whether the samples are worth using or not. I wrote code to take the output and put it into a form to put online where our techs and our clients can see and use it.

And it sucked.

It sucked, in part, because I have two loops, one to find which GEL image to deal with and one for the EGRAMs. I pull everything into one loop, using grep() to find which GEL and EGRAM to pull for any point.

When I wrote the old code, things like map() and grep() were foreign concepts, and I might think twice about using them if I felt there was a chance that a programmer that wasn't me would have to maintain this code. The new solution is not so much shorter, but I feel it is more straightforward.

It could be better. I felt the call, for example, to redo this in Template Toolkit, pulling away from CGI.pm, but that struck me as a waste until we move forward on a wholescale transfer from CGI to Dancer or another framework.

Anyway, here's the code.

	# ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
	# takes in the hashref/object from get_all_that_data
	# returns the HTML that either displays or gets entered or put into the
	# wiki
	sub format_all_that_data {
	my ( $data ) = @_ ;
	my $output ;
	my $legend ;
	my $egram ;
	my $cgi = new CGI ;
	# Header info
	my $header ;
	my $chip = $data->{ apr_id } ;
	my $operator = $data->{ apr }->{ experimenter } ;
	my $name = $data->{ apr }->{ chip_name } ;
	my $date = $data->{ apr }->{ time_entered } ;
	my $filename = $data->{ apr }->{ filename } ;
	$date =~ s/ / at / ;
	$header .=
	$cgi->big(
	$cgi->strong( "Chip # $chip - $name Chip run by $operator on $date" ) ) ;
	$output .= $cgi->div( $header ) ;
	$output .= "\n" ;
	# Display the GELs
	my $div ;
	$div .= $cgi->div( $cgi->strong( 'Faux Gel Images' ) ) ;
	$div .= "\n" ;
	my ( $num_samples ) =
	$data->{ apr }->{ chip_comment } =~ /num_samples\s+(\d+)/ ;
	for my $reg ( 'Ladder.jpg', map { "Sample${_}.jpg" } 1 .. 12 ) {
	for my $image ( grep { /GEL/ } @{ $data->{ images } } ) {
	next if !grep { /$reg/ } $image ;
	my $img = join '', $data->{ web_directory }, $image ;
	my $title ;
	if ( $reg =~ /Ladder.jpg/ ) {
	$title = 'Ladder' ;
	}
	else {
	my ( $num ) = $image =~ /Sample(\d+)\.jpg/ ;
	my ( $sample_id ) =
	grep {
	my @sample_name = split / - /,
	$data->{ samples }->{ $_ }->{ sample_name } ;
	# my $lane = $sample_name[ 2 ] ;
	my $lane = $sample_name[ 2 ] % $num_samples ;
	$lane = $lane == 0 ? $num_samples : $lane ;
	$lane == $num ;
	}
	sort keys %{ $data->{ samples } } ;
	next unless defined $sample_id ;
	my $sample = $data->{ samples }->{ $sample_id } ;
	my $acc_id = $sample->{ accession_id } ;
	my $accession = $data->{ accessions }->{ $acc_id } ;
	my $library_name = $accession->{ library_name } ;
	$title = join ' ', $acc_id, $library_name ;
	}
	$div .= $cgi->div(
	{ style => 'display: inline-block ;' },
	$cgi->a(
	{ href => $img, },
	$cgi->img( {
	src => $img,
	title => $title,
	style => "padding: 0px ; border: 0",
	}
	),
	),
	) ;
	$div .= "\n" ;
	}
	}
	$output .= $div ;
	$output .= "\n" ;
	# Display the EGRAMs
	$output .= $cgi->div( $cgi->b( 'Electropherograms' ) ) ;
	$output .= "\n" ;
	for my $reg ( map { "Sample${_}.jpg" } 1 .. 12 ) {
	for my $image ( grep { /EGRAM/ } @{ $data->{ images } } ) {
	next if !grep { /$reg/ } $image ;
	next if $image !~ /Sample/ ;
	my ( $num ) = $image =~ /Sample(\d+)\.jpg/ ;
	my ( $sample_id ) =
	grep {
	my @sample_name = split / - /,
	$data->{ samples }->{ $_ }->{ sample_name } ;
	my $lane = $sample_name[ 2 ] % $num_samples ;
	$lane = $lane == 0 ? $num_samples : $lane ;
	$lane == $num ;
	}
	sort keys %{ $data->{ samples } } ;
	# I had $lane == $num commented out. That is important
	# because this is in 'grep' which needs a boolean output
	# to tell whether a result is to be passed through or not
	my $sample = $data->{ samples }->{ $sample_id } ;
	my $acc_id = $sample->{ accession_id } ;
	my $accession = $data->{ accessions }->{ $acc_id } ;
	my $library_name = $accession->{ library_name } ;
	my $version = $sample->{ version } ;
	my $comment = $sample->{ sample_comment } ;
	my @comment = split m{ - }, $comment ;
	my $img = join '', $data->{ web_directory }, $image ;
	my $title = join ' ', $acc_id, $library_name ;
	my $concentration = $sample->{ concentration } ;
	my $rin = $sample->{ rin } ;
	my $average_size = $sample->{ average_size } ;
	my ( $dil ) = grep { /dil:/ } @comment ;
	my ( $vol ) = grep { /vol:/ } @comment ;
	my ( $load ) = grep { /load:/ } @comment ;
	# 'if' added to suppress errors DAJ 2015-11
	( $dil ) = reverse split m{\:}, $dil if $dil ;
	( $vol ) = reverse split m{\:}, $vol if $vol ;
	( $load ) = reverse split m{\:}, $load if $load ;
	my $high_sensitivity = 0 ;
	$image =~ /High Sensitivity/ and $high_sensitivity = 1 ;
	my $table_feed = {
	accession => $accession,
	acc_id => $acc_id,
	average_size => $average_size,
	comment => $comment,
	comments => \@comment,
	concentration => $concentration,
	dil => $dil,
	image => $image,
	img => $img,
	library_name => $library_name,
	load => $load,
	name => $name,
	num => $num,
	rin => $rin,
	sample => $sample,
	title => $title,
	version => $version,
	vol => $vol,
	} ;
	if ( $name eq 'DNA High Sensitivity' ) {
	$egram .= $cgi->div(
	make_table_high_sensitivity( $table_feed ) ) ;
	}
	else {
	$egram .= $cgi->div( make_table_normal( $table_feed ) ) ;
	}
	$egram .= "\n" ;
	}
	}
	$output .= $cgi->div( $egram ) ;
	$output .= "<!-- OLD -->\n" ;
	return $output ;
	}

view raw 01_Old.pl hosted with ❤ by GitHub

	# ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
	# takes in the hashref/object from get_all_that_data
	# returns the HTML that either displays or gets entered or put into the
	# wiki
	sub format_all_that_data {
	my ($data) = @_ ;
	my $output ;
	my $legend ;
	my $cgi = new CGI ;
	# Header info
	my $header ;
	my $chip = $data->{apr_id} ;
	my $operator = $data->{apr}->{experimenter} ;
	my $name = $data->{apr}->{chip_name} ;
	my $date = $data->{apr}->{time_entered} ;
	my $filename = $data->{apr}->{filename} ;
	$date =~ s/ / at / ;
	$header
	.= $cgi->big(
	$cgi->strong("Chip # $chip - $name Chip run by $operator on $date")
	) ;
	my @gels ;
	my @egrams ;
	my ($num_samples)
	= $data->{apr}->{chip_comment} =~ /num_samples\s+(\d+)/ ;
	for my $reg ( 'Ladder.jpg', map {"Sample${_}.jpg"} 1 .. 12 ) {
	my ($gel_image) = grep {m{$reg}}
	grep {m{GEL}} @{ $data->{images} } ;
	my ($egram_image) = grep {m{$reg}}
	grep {m{EGRAM}} @{ $data->{images} } ;
	my ($num) = $reg =~ /Sample(\d+)\.jpg/ ;
	my $title ;
	if ( $reg =~ /Ladder.jpg/ ) {
	$title = 'Ladder' ;
	}
	my $table_feed ;
	$num = !defined $num ? 0 : $num ;
	my ($sample_id) = grep {
	my @sample_name = split / - /,
	$data->{samples}->{$_}->{sample_name} ;
	my $lane = $sample_name[2] % $num_samples ;
	$lane = $lane == 0 ? $num_samples : $lane ;
	defined $num ? ( $lane == $num ) : 0 ;
	}
	sort keys %{ $data->{samples} } ;
	$sample_id = !defined $sample_id ? 'Ladder' : $sample_id ;
	next unless defined $gel_image ;
	if ( $reg =~ /Ladder.jpg/ ) { $title = 'Ladder' }
	else {
	my $sample = $data->{samples}->{$sample_id} ;
	my $acc_id = $sample->{accession_id} ;
	my $accession = $data->{accessions}->{$acc_id} ;
	my $library_name = $accession->{library_name} ;
	$title = join ' ', $acc_id, $library_name ;
	my $version = $sample->{version} ;
	my $comment = $sample->{sample_comment} ;
	my @comment = split m{ - }, $comment ;
	my $concentration = $sample->{concentration} ;
	my $rin = $sample->{rin} ;
	my $average_size = $sample->{average_size} ;
	my ($dil) = grep {/dil:/} @comment ;
	my ($vol) = grep {/vol:/} @comment ;
	my ($load) = grep {/load:/} @comment ;
	# 'if' added to suppress errors DAJ 2015-11
	($dil) = reverse split m{\:}, $dil if $dil ;
	($vol) = reverse split m{\:}, $vol if $vol ;
	($load) = reverse split m{\:}, $load if $load ;
	my $high_sensitivity = 0 ;
	$egram_image =~ /High Sensitivity/ and $high_sensitivity = 1 ;
	$table_feed = {
	accession => $accession,
	acc_id => $acc_id,
	average_size => $average_size,
	comment => $comment,
	comments => \@comment,
	concentration => $concentration,
	dil => $dil,
	library_name => $library_name,
	load => $load,
	name => $name,
	num => $num,
	rin => $rin,
	sample => $sample,
	title => $title,
	version => $version,
	vol => $vol,
	} ;
	}
	# TEMPLATE TOOLKIT THIS MESS
	if ( defined $gel_image ) {
	my $gel_img = join '', $data->{web_directory}, $gel_image ;
	my $egram_img = join '', $data->{web_directory}, $egram_image ;
	$table_feed->{image} = $egram_image ;
	$table_feed->{img} = $egram_img ;
	my $div ;
	$div .= $cgi->div(
	{ style => 'display: inline-block ;' },
	$cgi->a(
	{ href => $gel_img, },
	$cgi->img(
	{ src => $gel_img,
	title => $title,
	style => "padding: 0px ; border: 0",
	}
	),
	),
	) ;
	$div .= "\n" ;
	push @gels , $div ;
	if ( $egram_image !~ /Ladder/ ) {
	my $egram ;
	if ( $table_feed->{name} eq 'DNA High Sensitivity' ) {
	$egram .= $cgi->div(
	make_table_high_sensitivity($table_feed) ) ;
	}
	else {
	$egram .= $cgi->div( make_table_normal($table_feed) ) ;
	}
	push @egrams , $egram ;
	}
	}
	}
	$output .= $cgi->div($header) ;
	$output .= "\n" ;
	# Display the GELs
	$output .= $cgi->div( $cgi->strong('Faux Gel Images') ) ;
	$output .= "\n" ;
	$output .= join "\n" , @gels ;
	$output .= "\n" ;
	# Display the EGRAMs
	$output .= $cgi->div( $cgi->b('Electropherograms') ) ;
	$output .= "\n" ;
	my $egram = join "\n" , @egrams ;
	$output .= $cgi->div($egram) ;
	$output .= "<!-- NEW -->\n" ;
	return $output ;
	}

view raw 02_New.pl hosted with ❤ by GitHub