The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package PrimeTime::Report;

use 5.008005;
use strict;
use warnings;

use Yorkit;
use Text::Table;
require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use PrimeTime::Report ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
	
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
	
);

our $VERSION = '0.01';


# Preloaded methods go here.

# Below is stub documentation for your module. You'd better edit it!

=head1 NAME

PrimeTime::Report - Parser for PrimeTime report.

=head1 SYNOPSIS

  use PrimeTime::Report;
  my $pt = new PrimeTime::Report;

  my $file = shift;
  $pt->read_file($file);

  $pt->print_summary();

  $pt->print_path(5);

=head1 DESCRIPTION

PrimeTime::Report help you extract useful information from PrimeTime report.

=cut

=head1 BASIC FUNTIONS

=cut
# new
# {{{

=head2 new

To new a PrimeTime::Report object.

=cut
sub new {
  my $self=shift;
  my $class=ref($self) || $self;
  my %h;
  return bless {%h}, $class;
}
# }}}
# read_file
# {{{

=head2 read_file

Read and parse the PrimeTime report.

 $pt->read_file($file);

=cut
sub read_file {
  my $self=shift;
  my $infile=shift;

  open FIN, "<$infile" or die "$!";
  undef $/;
  my $file = <FIN>;
  $/='\n';
  close FIN;

  my @path = $file =~ m/(Startpoint.*?slack.*?)$/gsm;
  my $count = 0;
  my $startpoint;
  my $endpoint;
  my $path_group;
  my $path_type;
  my $uncertainty;
  my $slack;
  my $clock_domain;
  my @part;
  my $clock_source_rise_time;
  my $clock_hit_source_FF;
  my $clock_hit_capture_FF;
  my $clock_capture_rise_time;
  my $clock_period;
  my $clock_latency_source;
  my $clock_latency_capture;
  my $skew;
  my @part_source;
  my $clock_path_capture;

  foreach my $eachpath (@path){
    $startpoint   = "N/A" if(!(($startpoint) = $eachpath =~ m/Startpoint: (.*?)$/m));
    $endpoint     = "N/A" if(!(($endpoint) = $eachpath =~ m/Endpoint: (.*?)$/m));
    $path_group   = "N/A" if(!(($path_group) = $eachpath =~ m/Path Group: (.*?)$/m));
    $path_type    = "N/A" if(!(($path_type) = $eachpath =~ m/Path Type: (.*?)$/m));
    $uncertainty  = "N/A" if(!(($uncertainty) = $eachpath =~ m/inter-clock uncertainty[ ]+(\S*?) /m));
    $slack        = "N/A" if(!(($slack) = $eachpath =~ m/^[ ]+slack \(\w+\)[ ]+(\S*?)$/sm));
    $clock_domain = "N/A" if(!(($clock_domain) = $eachpath =~ m/ clock (\S*?) \(rise edge\)/m));
    @part = split(/^\s*$/sm,$eachpath);
    @part_source = split(m/($startpoint.*)/sm, $part[1]);
    ($clock_path_capture) = $part[2] =~ m/(.*$endpoint.*? [rf])/sm;
    $clock_source_rise_time = "0" if(!(($clock_source_rise_time) = $part[1] =~ m/ clock \S*? \(rise edge\)[ ]+(\S*?) /m));
    $clock_hit_source_FF    = "0" if(!(($clock_hit_source_FF) = $part[1] =~ m/$startpoint.*?(\S*?) [rf]/sm));
    $clock_capture_rise_time= "0" if(!(($clock_capture_rise_time) = $part[2] =~ m/ clock \S*? \(rise edge\)[ ]+(\S*?) /m));
    $clock_period           = $clock_capture_rise_time - $clock_source_rise_time;
    $clock_hit_capture_FF    = "0" if(!(($clock_hit_capture_FF) = $part[2] =~ m/$endpoint.*?(\S*?) [rf]/sm));

    if(!(($clock_latency_source) = $part[1] =~ m/ clock network delay \(\w+\)[ ]+(\S*?) /m)){
      $clock_latency_source = $clock_hit_source_FF - $clock_source_rise_time;
    }
    if(!(($clock_latency_capture) = $part[2] =~ m/ clock network delay \(\w+\)[ ]+(\S*?) /m)){
      $clock_latency_capture = $clock_hit_capture_FF - $clock_capture_rise_time;
    }
    $skew = sprintf("%.4f",$clock_latency_capture - $clock_latency_source);

    $self->{paths}->{$count} = {
      raw=> $eachpath,
      startpoint => $startpoint,
      endpoint => $endpoint,
      path_group => $path_group,
      path_type => $path_type,
      clock_domain => $clock_domain,
      clock_period => $clock_period,
      uncertainty => $uncertainty,
      clock_path_source => $part_source[0],
      clock_path_capture => $clock_path_capture,
      clock_source_rise_time => $clock_source_rise_time,
      clock_hit_source_FF => $clock_hit_source_FF,
      clock_latency_source => $clock_latency_source,
      clock_latency_capture => $clock_latency_capture,
      skew => $skew,
      slack => $slack,
      start_part => $part_source[1],
      end_part=>$part[2],
    };
    $count++;
  }
  $self->{size}=$count+1;
}
# }}}
# print_summary
# {{{

=head2 print_summary

 available input option: startpoint, endpoint, path_group, path_type, clock_domain, clock_period, uncertainty
                         clock_latency_capture, clock_latency_source
 $pt->print_summary("slack", "startpoint", "endpoint");

=cut
sub print_summary {
  my $self=shift;
  my @column=@_;
  my $size = $self->{size} - 1;
  my $i;
  my $tb = Text::Table->new();
  my @a=();

  for($i=0;$i<$size;$i=$i+1){
    push @a, $i+1;
    foreach (@column){
      push @a, $self->{paths}->{$i}->{$_};
    }
    $tb->load([@a]);
    @a=();
  }
  print $tb;
}
# }}}
# print_path
# {{{

=head2 print_path

 Input1: Path number
 Input2: Path length you want to show. Default is 110.
 $pt->print_path(3);

=cut
sub print_path {
  my $self=shift;
  my $number = shift;
  my $length = shift;
  $length = 110 if (!defined $length);
  my $tb = Text::Table->new();
  my $path_no = $number-1;
  my $start_part = $self->{paths}->{$path_no}->{start_part};
  my @p_ref = $self->path_extract($start_part, $length, "splited");

  for (@p_ref) {
    $tb->load([@$_]);
  }

  print sprintf("%23s %s", "Path Number: ", $number),"\n";
  print sprintf("%23s %s", "Path Type: ",$self->{paths}->{$path_no}->{path_type}),"\n";
  print sprintf("%23s %s", "Path Group: ",$self->{paths}->{$path_no}->{path_group}),"\n";
  print sprintf("%23s %s", "Uncertanty: ",$self->{paths}->{$path_no}->{uncertainty}),"\n";
  print sprintf("%23s %s", "Clock Source Latency: ",$self->{paths}->{$path_no}->{clock_latency_source}),"\n";
  print sprintf("%23s %s", "Clock Capture Latency: ",$self->{paths}->{$path_no}->{clock_latency_capture}),"\n";
  print sprintf("%23s %s", "Skew: ",$self->{paths}->{$path_no}->{skew}),"\n";
  print sprintf("%23s %s", "Clock Period: ",$self->{paths}->{$path_no}->{clock_period}),"\n";
  print sprintf("%23s %s", "Slack: ",$self->{paths}->{$path_no}->{slack}),"\n";
  if($self->{paths}->{$path_no}->{path_type} eq "max") {
    my $speed = 1/($self->{paths}->{$path_no}->{clock_period} - $self->{paths}->{$path_no}->{slack})*1000;
    print sprintf("%23s %d", "Speed: ",$speed),"\n";
  }
  print $tb;
}
# }}}
# print_path_raw
# {{{

=head2 print_path_raw

Print the specified path in orignal format.

 Input: path number
 Ex:
 $pt->print_path_raw(3);

=cut
sub print_path_raw {
  my $self=shift;
  my $number = shift;
  my $path_no = $number-1;
  print $self->{paths}->{$path_no}->{raw};
}
# }}}
# path_extract
# {{{

=head2 path_extract

Split each line by space and create a 2D array.

 Input1: text which contants path information
 Input2: the path length you want to show
 Ex:
 $pt->path_extract($path, $length);

=cut
sub path_extract {
  my $self=shift;
  my $path = shift;
  my $length = shift;
  #my $splited = shift;
  my @a;
  my @path_line;

  my $p;
  #if($splited eq "splited"){
    while($path =~ m'(^\s+[\-0-9a-zA-Z./_]+/[\-0-9a-zA-Z./_]+.*? [fr])'gsm){
      $p = $1;
      $p =~ s/\n//;
  #    if($p !~ /0\.0000/){
        push @a, $p;
  #    }
    };
  #}else{
  #  @path_line = split(/\n/,$path);
  #  @a = grep m'^\s+[\-0-9a-zA-Z./_]+/[\-0-9a-zA-Z./_]+', @path_line;
  #}

  # remove * in each path
  for (@a) {s/\*//};

  
  my @path_2D;
  @path_2D = map {[split]} @a;


  for my $aref (@path_2D){
    @$aref[0] = substr(@$aref[0], -$length);
  }

  return @path_2D;
}
# }}}
# clk_path
# {{{

=head2 clk_path

 Input1: text which contants clock path information
 Input2: "source" or "capture"
 Ex:
 $pt->clk_path($clock_path, "source");

=cut
sub clk_path {
  my $self=shift;
  my $path_no = shift;
  my $type = shift;
  $path_no--;

  my $tb = Text::Table->new();

  my @p_ref;
  if($type eq "source"){
    @p_ref = $self->path_extract($self->{paths}->{$path_no}->{clock_path_source}, 110);
  }
  elsif($type eq "capture"){
    @p_ref = $self->path_extract($self->{paths}->{$path_no}->{clock_path_capture}, 110);
  }

  for (@p_ref) {
    $tb->load([@$_]);
  }

  print $tb;
}
# }}}

=head1 Tools

Three tools provided as gedgets and also examples using PrimeTime::Report.

=head2 pr-summary.pl

=head2 pr-path.pl

=head2 pr-clk_path.pl

=head1 AUTHOR

yorkwu, E<lt>yorkwuo@gmail.com<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2010 by yorkwu

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.


=cut
1;
# vim:fdm=marker