Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

(note: I've put my cleaned up verion of this code in a reply below.)

Well, tye went and did it once again, convinced me (with nary a nudge) to post something. So here goes. I have here some working code written casually. But it's ugly as homemade sin and while I am actually refactoring it for simplification, I'd be interested to see how other monks take a hack at it.

Background: For any given date I need to derive the following:

The last "business date" from the previous calendar quarter. Business date is "Monday through Friday" (i.e. if last date of the quarter is a Sunday, pull two days off and report the Friday.)

A couple notes:

  • These tests pass and the code works
  • Holidays are irrelevant.
  • Timezones are also irrelevant.
  • The resulting code is stupid
  • This runs at most once every few weeks.
  • NO CPAN. If it didn't ship with perl 5.6, it's out.(*sigh* yes really :-/)

So I set about TDD'ing the function "get_last_bus_day_of_prev_quarter" (worst name ever. Also taking suggestions to replace that) and it's dependencies in a separate script and all the expected stuff happened. As I encountered complexity that warranted a new testable function I added the tests for that function to the top of the list. I found stupid errors and fixed them. I came up with "really clever" solutions and... avoided them as I couldn't identify them after a bio-break so I went out of my way to not do anything overly clever. I found that I was biasing towards making the test lines themselves easy to read.

Then I was done. It worked. All my tests passed happy nice nice, and I plugged it in to the main code body.

But I was remarkably unsatisfied. It's...well, look at it. It's awful. It's actually the same size as the rest of the script it supports. Micromanaging the testing the way I did produced "small functional units" the way it's supposed to. But in producing "clean interfaces" (i.e. single string representations of dates and their kin) I ended up reproducing the extraction/concatenation logic all over the place.

What this REALLY means of course is that the task isn't done. I was kvetching about this and how I'm now going through and replacing those composite strings with their component parts (and how I should have caught that up front) when tye suggested I post it, looking to see how other people tackle the simplification problem.

So here ya go. This is the whole script, tests and all (for that one function.) How would you simplify this? (I do already have some stuff in the works.)

#!/usr/bin/perl -w use strict; use warnings; use Time::Local; use Test::More "no_plan"; test(); sub test { ok ( identify_quarter("201101") eq "2011Q1"); ok ( identify_quarter("201102") eq "2011Q1"); ok ( identify_quarter("201103") eq "2011Q1"); ok ( identify_quarter("201104") eq "2011Q2"); ok ( identify_quarter("201105") eq "2011Q2"); ok ( identify_quarter("201106") eq "2011Q2"); ok ( identify_quarter("201107") eq "2011Q3"); ok ( identify_quarter("201108") eq "2011Q3"); ok ( identify_quarter("201109") eq "2011Q3"); ok ( identify_quarter("201110") eq "2011Q4"); ok ( identify_quarter("201111") eq "2011Q4"); ok ( identify_quarter("201112") eq "2011Q4"); ok ( identify_quarter("201201") eq "2012Q1"); ok ( get_previous_quarter("2011Q4") eq "2011Q3"); ok ( get_previous_quarter("2011Q3") eq "2011Q2"); ok ( get_previous_quarter("2012Q1") eq "2011Q4"); ok ( last_month_of_quarter(1) == 3); ok ( last_month_of_quarter(2) == 6); ok ( last_month_of_quarter(3) == 9); ok ( last_month_of_quarter(4) == 12); ok ( get_next_month("201101") eq "201102"); ok ( get_next_month("201112") eq "201201"); ok ( last_day_of_month("201101") == 31); ok ( last_day_of_month("201202") == 29); ok ( get_last_month_of_quarter("2011Q1") eq "201103"); ok ( get_last_month_of_quarter("2011Q2") eq "201106"); ok ( get_last_month_of_quarter("2011Q3") eq "201109"); ok ( get_last_month_of_quarter("2011Q4") eq "201112"); ok ( get_last_month_of_quarter("2012Q1") eq "201203"); ok ( get_last_day_of_prev_quarter("20110101") eq "20101231"); ok ( get_last_day_of_prev_quarter("20110203") eq "20101231"); ok ( get_last_day_of_prev_quarter("20110310") eq "20101231"); ok ( get_last_day_of_prev_quarter("20110331") eq "20101231"); ok ( get_last_day_of_prev_quarter("20110415") eq "20110331"); ok ( get_last_day_of_prev_quarter("20110516") eq "20110331"); ok ( get_last_day_of_prev_quarter("20110629") eq "20110331"); ok ( get_last_day_of_prev_quarter("20110731") eq "20110630"); ok ( get_last_day_of_prev_quarter("20110805") eq "20110630"); ok ( get_last_day_of_prev_quarter("20110930") eq "20110630"); ok ( get_last_day_of_prev_quarter("20111030") eq "20110930"); ok ( get_last_day_of_prev_quarter("20111130") eq "20110930"); ok ( get_last_day_of_prev_quarter("20111231") eq "20110930"); ok ( get_last_bus_day_of_prev_quarter("20110901") eq "20110630"); ok ( get_last_bus_day_of_prev_quarter("20120101") eq "20111230"); } sub get_last_day_of_prev_quarter { my ($date) = @_; my $this_quarter = identify_quarter($date); my $quarter = get_previous_quarter($this_quarter); my $last_month_of_quarter = get_last_month_of_quarter($quarter); my $ldom = last_day_of_month($last_month_of_quart +er); return $last_month_of_quarter . $ldom; } sub get_last_bus_day_of_prev_quarter { my ($date) = @_; my $new_date = get_last_day_of_prev_quarter($date); my $year = substr($new_date,0,4); my $month = substr($new_date,4,2); my $day = substr($new_date,6,2); my $epoch = timelocal(0,0,12, $day, $month-1, $year-1900); my @timestuff = localtime($epoch); # # If the day is a Sunday (0) or a Saturday (6) # # Subtract 1 or 2 days from the day. my $date_diff = 0; if ($timestuff[6] == 0) { $date_diff = 2; } if ($timestuff[6] == 6) { $date_diff = 1; } if ($date_diff > 0) { $epoch = $epoch - (60*60*24) * $date_diff; } @timestuff = localtime($epoch); # # Rebuild the YYYYMMDD string from the localtime bits. # return $timestuff[5] + 1900 . sprintf( "%02d",$timestuff[4] + 1) +. "$timestuff[3]"; } sub get_last_month_of_quarter { my ($yyyymm) = @_; return substr($yyyymm,0,4) . sprintf("%02d",last_month_of_quarter( +substr($yyyymm,5,1))); } sub last_month_of_quarter { my ($quarter) = @_; return $quarter * 3; } sub last_day_of_month { # This logic is moronic, but it works. # To get the last day of a given month, first take the first day # of the first month, convert it to epoch seconds, subtract a day # (86400 seconds), then re-convert back and pull the "day of month +" # element out of the list. my ($yyyymm) = @_; my $next_day = get_next_month($yyyymm) . "01"; my $epoch = timelocal(0,0,12,1, substr($next_day,4,2)-1, substr($next_day,0,4)-1900); $epoch = $epoch - ( 60*60*24 ); my @timestuff = localtime($epoch); return $timestuff[3]; } sub get_next_month { my ($yyyymm) = @_; my $year = substr($yyyymm,0,4); my $month = substr($yyyymm,4,2); if ($month == 12) { $month = 1; $year++; } else { $month++; } return $year . sprintf "%02d",$month; } sub get_previous_quarter { my ($quarter) = @_; my $year = substr($quarter,0,4); my $q = substr($quarter,5,1); if ($q == 1) { $q = 4; $year--; } else { $q--; } return "$year" . "Q$q"; } sub identify_quarter { my ($date) = @_; my $year = substr ($date,0,4); my $month = substr ($date,4,2); my $quarter = int(($month-1) / 3) +1; return "$year" . "Q$quarter"; }
Me

In reply to Care to simplify some working code? by Voronich

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (4)
As of 2024-03-19 07:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found