Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Candle Time

by Random_Walk (Parson)
on May 16, 2013 at 13:30 UTC ( #1033827=perlquestion: print w/ replies, xml ) Need Help??
Random_Walk has asked for the wisdom of the Perl Monks concerning the following question:

Dear Monks, I am having fun with timestamps

I am extracting a lot of data from a data warehouse and have to convert the legacy timestamps (see code) to human readable. Of course the requirement has changed and I now need epoch time too. This code runs on every row returned for a lot of data so I want to be a little efficient.

Any optimisations of the following code, or other ways to do it welcome.

use strict; use warnings; use POSIX qw(mktime); for my $t (<DATA>) { # Handle time, this is stored as a 'Candle' timestamp # "CYYMMDDhhmmssSSS" where C is the century (0 for 20th, 1 for 21st, + etc). chomp ($t); print $t; my @bits = split //, $t; # use these later # This is how I convert it to human readable now my $c=substr $t,1,1,''; # grab the century substr $t, 2,0,'-';substr $t, 5,0,'-';substr $t, 8,0,' '; # do the + date substr $t,11,0,':';substr $t,14,0,':';substr $t,17,0,'.'; # do the t +ime $t = 19+$c.$t; # add back the century print " = $t\n"; # This is what I am thinking to go to epoch seconds # of course I would grab my human version from here too my $C = $bits[0] + 19; my $Y = $C . (join "", @bits[ 1,2]); my $M = join "", @bits[ 3,4 ]; my $D = join "", @bits[ 5,6 ]; my $h = join "", @bits[ 7,8 ]; my $m = join "", @bits[ 9,10]; my $s = join "", @bits[11,12]; print "c:$C y:$Y M:$M D:$D h:$h m:$m s:$s\n"; my $epoch = mktime($s, $m, $h, $D, $M-1, $Y-1900,); print scalar localtime $epoch; print $/; } __DATA__ 1130508154533613 1130508160033800 1130508161534113 1130508163034519 1130508164535019 1130508164535019 1130508170035191 1130508171533160 1130508173033660 1130508174534097 1130508180034535 1130424070116695 1130425070118790 1130426070118834 1130427070122888 1130428070123115 1130429070126161 1130430070127538 1130501070128195 1130502070131210 1130503070131969 1130504070135198

Cheers,
R.

Pereant, qui ante nos nostra dixerunt!

Comment on Candle Time
Download Code
Re: Candle Time
by hdb (Prior) on May 16, 2013 at 13:57 UTC

    Just compressing your code a bit:

    use strict; use warnings; use POSIX qw(mktime); for (<DATA>) { my ($C, $Y, $M, $D, $h, $m, $s) = unpack "A1 A2 A2 A2 A2 A2 A2"; my $epoch = mktime($s, $m, $h, $D, $M-1, $Y+100*$C); print scalar localtime $epoch; print $/; } __DATA__ 1130508154533613
      yup, unpack is faster than split or m//atch
      #!/usr/bin/perl -- use strict; use warnings; Fudge('1130508154533613'); sub Fudge { use POSIX qw( mktime strftime ); my ( $Y, $M, $D, $h, $m, $s, $ms ) = unpack 'A3 (A2)5 A3', $_[-1] +; my $epoch = mktime( $s, $m, $h, $D, $M, $Y, -1, -1, -1 ); print "$epoch = ", strftime( '%Y-%m-%d %H:%M:%S', $s, $m, $h, $D, $M, $Y, -1, -1, - +1 ), ".$ms", $/; print scalar localtime $epoch; print $/; } __END__ 1370731533 = 2013-06-08 15:45:33.613 Sat Jun 8 15:45:33 2013
Re: Candle Time
by Anonymous Monk on May 16, 2013 at 14:12 UTC

     my $Y = $C . (join "", @bits[ 1,2]);  ... $Y-1900,

    Well, that seems wrong, if $Y is first 3 chars, just get it that way , no need for append/add/subtract..

    Also,

    1130508154533613 = 2013-05-08 15:45:33.613 c:20 y:2013 M:05 D:08 h:15 m:45 s:33 Wed May 8 15:45:33 2013
    If your year isn't 4 digits, are you sure your month is off-by-one?

    I get

    #!/usr/bin/perl -- use strict; use warnings; Fudge('1130508154533613'); sub Fudge { use POSIX(); my( $Y , $M, $D, $h, $m, $s , $ms ) = $_[-1] =~ m{^(.{3})(..)(..)( +..)(..)(..)(...)$}; my $epoch = POSIX::mktime( $s, $m, $h, $D, $M, $Y, -1, -1, -1 ); print "$epoch = ", POSIX::strftime('%Y-%m-%d %H:%M:%S', $s, $m, $h, $D, $M, $Y, - +1, -1, -1 ), ".$ms" , $/; print scalar localtime $epoch; print $/; } __END__ 1370731533 = 2013-06-08 15:45:33.613 Sat Jun 8 15:45:33 2013
Re: Candle Time
by johngg (Abbot) on May 16, 2013 at 21:24 UTC

    I can't find the node at the moment but I remember BrowserUk posting a solution where taking references to substrs of a buffer gave better performance than using unpack. IIRC, this was because unpack had the overhead of re-parseing the template string every time it was invoked. This benchmark seems to bear that out.

    use strict; use warnings; use Benchmark qw{ cmpthese }; use Test::More qw{ no_plan }; my $buffer = q{1130508154533}; my $revBuffer = q{3345150805113}; my $template = q{ a3 a2 a2 a2 a2 a2 }; my $rsYr = \ substr $buffer, 0, 3; my $rsMon = \ substr $buffer, 3, 2; my $rsDay = \ substr $buffer, 5, 2; my $rsHr = \ substr $buffer, 7, 2; my $rsMin = \ substr $buffer, 9, 2; my $rsSec = \ substr $buffer, 11, 2; open my $dataFH, q{<}, \ <<EOD or die $!; 1130508154533613 EOD my $start = tell $dataFH; my %methods = ( substr => sub { seek $dataFH, $start, 0; my $rev; while ( $buffer = <$dataFH> ) { $rev = join q{}, $$rsSec, $$rsMin, $$rsHr, $$rsDay, $$rsMon, $$rsYr; } return $rev; }, unpack => sub { seek $dataFH, $start, 0; my $rev; while ( $buffer = <$dataFH> ) { my @elems = unpack $template, $buffer; $rev = join q{}, reverse @elems } return $rev; }, ); foreach my $method ( sort keys %methods ) { ok( $methods{ $method }->() eq $revBuffer, $method ); } close $dataFH or die $!; open $dataFH, q{<}, \ <<EOD or die $!; 1130508154533613 1130508160033800 1130508161534113 1130508163034519 1130508164535019 1130508164535019 1130508170035191 1130508171533160 1130508173033660 1130508174534097 1130508180034535 1130424070116695 1130425070118790 1130426070118834 1130427070122888 1130428070123115 1130429070126161 1130430070127538 1130501070128195 1130502070131210 1130503070131969 1130504070135198 EOD $start = tell $dataFH; cmpthese( -10, { map { my $codeStr = q[sub { my $rev = $methods{ ] . $_ . q[ }->(); }]; $_ => eval $codeStr; } keys %methods } ); close $dataFH or die $!;

    The output.

    ok 1 - substr ok 2 - unpack Rate unpack substr unpack 17980/s -- -56% substr 40619/s 126% -- 1..2

    I've cocked benchmarks up before so this might be wide of the mark but, hopefully, I have remembered BrowserUk's post correctly and this will be of use.

    Update: This is BrowserUk's node that I was remembering.

    Cheers,

    JohnGG

      johngg++ and of course BrowserUK

      This is just the kind of cunning solution that I was hoping for

      Cheers,
      R.

      Pereant, qui ante nos nostra dixerunt!

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1033827]
Approved by Eliya
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (7)
As of 2014-11-27 23:39 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (190 votes), past polls