File Coverage

blib/lib/PrimeTime/Report.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package PrimeTime::Report;
2              
3 1     1   54114 use 5.008005;
  1         4  
  1         45  
4 1     1   7 use strict;
  1         2  
  1         37  
5 1     1   6 use warnings;
  1         7  
  1         43  
6              
7 1     1   625 use Yorkit;
  0            
  0            
8             use Text::Table;
9             require Exporter;
10              
11             our @ISA = qw(Exporter);
12              
13             # Items to export into callers namespace by default. Note: do not export
14             # names by default without a very good reason. Use EXPORT_OK instead.
15             # Do not simply export all your public functions/methods/constants.
16              
17             # This allows declaration use PrimeTime::Report ':all';
18             # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
19             # will save memory.
20             our %EXPORT_TAGS = ( 'all' => [ qw(
21            
22             ) ] );
23              
24             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
25              
26             our @EXPORT = qw(
27            
28             );
29              
30             our $VERSION = '0.01';
31              
32              
33             # Preloaded methods go here.
34              
35             # Below is stub documentation for your module. You'd better edit it!
36              
37             =head1 NAME
38              
39             PrimeTime::Report - Parser for PrimeTime report.
40              
41             =head1 SYNOPSIS
42              
43             use PrimeTime::Report;
44             my $pt = new PrimeTime::Report;
45              
46             my $file = shift;
47             $pt->read_file($file);
48              
49             $pt->print_summary();
50              
51             $pt->print_path(5);
52              
53             =head1 DESCRIPTION
54              
55             PrimeTime::Report help you extract useful information from PrimeTime report.
56              
57             =cut
58              
59             =head1 BASIC FUNTIONS
60              
61             =cut
62             # new
63             # {{{
64              
65             =head2 new
66              
67             To new a PrimeTime::Report object.
68              
69             =cut
70             sub new {
71             my $self=shift;
72             my $class=ref($self) || $self;
73             my %h;
74             return bless {%h}, $class;
75             }
76             # }}}
77             # read_file
78             # {{{
79              
80             =head2 read_file
81              
82             Read and parse the PrimeTime report.
83              
84             $pt->read_file($file);
85              
86             =cut
87             sub read_file {
88             my $self=shift;
89             my $infile=shift;
90              
91             open FIN, "<$infile" or die "$!";
92             undef $/;
93             my $file = ;
94             $/='\n';
95             close FIN;
96              
97             my @path = $file =~ m/(Startpoint.*?slack.*?)$/gsm;
98             my $count = 0;
99             my $startpoint;
100             my $endpoint;
101             my $path_group;
102             my $path_type;
103             my $uncertainty;
104             my $slack;
105             my $clock_domain;
106             my @part;
107             my $clock_source_rise_time;
108             my $clock_hit_source_FF;
109             my $clock_hit_capture_FF;
110             my $clock_capture_rise_time;
111             my $clock_period;
112             my $clock_latency_source;
113             my $clock_latency_capture;
114             my $skew;
115             my @part_source;
116             my $clock_path_capture;
117              
118             foreach my $eachpath (@path){
119             $startpoint = "N/A" if(!(($startpoint) = $eachpath =~ m/Startpoint: (.*?)$/m));
120             $endpoint = "N/A" if(!(($endpoint) = $eachpath =~ m/Endpoint: (.*?)$/m));
121             $path_group = "N/A" if(!(($path_group) = $eachpath =~ m/Path Group: (.*?)$/m));
122             $path_type = "N/A" if(!(($path_type) = $eachpath =~ m/Path Type: (.*?)$/m));
123             $uncertainty = "N/A" if(!(($uncertainty) = $eachpath =~ m/inter-clock uncertainty[ ]+(\S*?) /m));
124             $slack = "N/A" if(!(($slack) = $eachpath =~ m/^[ ]+slack \(\w+\)[ ]+(\S*?)$/sm));
125             $clock_domain = "N/A" if(!(($clock_domain) = $eachpath =~ m/ clock (\S*?) \(rise edge\)/m));
126             @part = split(/^\s*$/sm,$eachpath);
127             @part_source = split(m/($startpoint.*)/sm, $part[1]);
128             ($clock_path_capture) = $part[2] =~ m/(.*$endpoint.*? [rf])/sm;
129             $clock_source_rise_time = "0" if(!(($clock_source_rise_time) = $part[1] =~ m/ clock \S*? \(rise edge\)[ ]+(\S*?) /m));
130             $clock_hit_source_FF = "0" if(!(($clock_hit_source_FF) = $part[1] =~ m/$startpoint.*?(\S*?) [rf]/sm));
131             $clock_capture_rise_time= "0" if(!(($clock_capture_rise_time) = $part[2] =~ m/ clock \S*? \(rise edge\)[ ]+(\S*?) /m));
132             $clock_period = $clock_capture_rise_time - $clock_source_rise_time;
133             $clock_hit_capture_FF = "0" if(!(($clock_hit_capture_FF) = $part[2] =~ m/$endpoint.*?(\S*?) [rf]/sm));
134              
135             if(!(($clock_latency_source) = $part[1] =~ m/ clock network delay \(\w+\)[ ]+(\S*?) /m)){
136             $clock_latency_source = $clock_hit_source_FF - $clock_source_rise_time;
137             }
138             if(!(($clock_latency_capture) = $part[2] =~ m/ clock network delay \(\w+\)[ ]+(\S*?) /m)){
139             $clock_latency_capture = $clock_hit_capture_FF - $clock_capture_rise_time;
140             }
141             $skew = sprintf("%.4f",$clock_latency_capture - $clock_latency_source);
142              
143             $self->{paths}->{$count} = {
144             raw=> $eachpath,
145             startpoint => $startpoint,
146             endpoint => $endpoint,
147             path_group => $path_group,
148             path_type => $path_type,
149             clock_domain => $clock_domain,
150             clock_period => $clock_period,
151             uncertainty => $uncertainty,
152             clock_path_source => $part_source[0],
153             clock_path_capture => $clock_path_capture,
154             clock_source_rise_time => $clock_source_rise_time,
155             clock_hit_source_FF => $clock_hit_source_FF,
156             clock_latency_source => $clock_latency_source,
157             clock_latency_capture => $clock_latency_capture,
158             skew => $skew,
159             slack => $slack,
160             start_part => $part_source[1],
161             end_part=>$part[2],
162             };
163             $count++;
164             }
165             $self->{size}=$count+1;
166             }
167             # }}}
168             # print_summary
169             # {{{
170              
171             =head2 print_summary
172              
173             available input option: startpoint, endpoint, path_group, path_type, clock_domain, clock_period, uncertainty
174             clock_latency_capture, clock_latency_source
175             $pt->print_summary("slack", "startpoint", "endpoint");
176              
177             =cut
178             sub print_summary {
179             my $self=shift;
180             my @column=@_;
181             my $size = $self->{size} - 1;
182             my $i;
183             my $tb = Text::Table->new();
184             my @a=();
185              
186             for($i=0;$i<$size;$i=$i+1){
187             push @a, $i+1;
188             foreach (@column){
189             push @a, $self->{paths}->{$i}->{$_};
190             }
191             $tb->load([@a]);
192             @a=();
193             }
194             print $tb;
195             }
196             # }}}
197             # print_path
198             # {{{
199              
200             =head2 print_path
201              
202             Input1: Path number
203             Input2: Path length you want to show. Default is 110.
204             $pt->print_path(3);
205              
206             =cut
207             sub print_path {
208             my $self=shift;
209             my $number = shift;
210             my $length = shift;
211             $length = 110 if (!defined $length);
212             my $tb = Text::Table->new();
213             my $path_no = $number-1;
214             my $start_part = $self->{paths}->{$path_no}->{start_part};
215             my @p_ref = $self->path_extract($start_part, $length, "splited");
216              
217             for (@p_ref) {
218             $tb->load([@$_]);
219             }
220              
221             print sprintf("%23s %s", "Path Number: ", $number),"\n";
222             print sprintf("%23s %s", "Path Type: ",$self->{paths}->{$path_no}->{path_type}),"\n";
223             print sprintf("%23s %s", "Path Group: ",$self->{paths}->{$path_no}->{path_group}),"\n";
224             print sprintf("%23s %s", "Uncertanty: ",$self->{paths}->{$path_no}->{uncertainty}),"\n";
225             print sprintf("%23s %s", "Clock Source Latency: ",$self->{paths}->{$path_no}->{clock_latency_source}),"\n";
226             print sprintf("%23s %s", "Clock Capture Latency: ",$self->{paths}->{$path_no}->{clock_latency_capture}),"\n";
227             print sprintf("%23s %s", "Skew: ",$self->{paths}->{$path_no}->{skew}),"\n";
228             print sprintf("%23s %s", "Clock Period: ",$self->{paths}->{$path_no}->{clock_period}),"\n";
229             print sprintf("%23s %s", "Slack: ",$self->{paths}->{$path_no}->{slack}),"\n";
230             if($self->{paths}->{$path_no}->{path_type} eq "max") {
231             my $speed = 1/($self->{paths}->{$path_no}->{clock_period} - $self->{paths}->{$path_no}->{slack})*1000;
232             print sprintf("%23s %d", "Speed: ",$speed),"\n";
233             }
234             print $tb;
235             }
236             # }}}
237             # print_path_raw
238             # {{{
239              
240             =head2 print_path_raw
241              
242             Print the specified path in orignal format.
243              
244             Input: path number
245             Ex:
246             $pt->print_path_raw(3);
247              
248             =cut
249             sub print_path_raw {
250             my $self=shift;
251             my $number = shift;
252             my $path_no = $number-1;
253             print $self->{paths}->{$path_no}->{raw};
254             }
255             # }}}
256             # path_extract
257             # {{{
258              
259             =head2 path_extract
260              
261             Split each line by space and create a 2D array.
262              
263             Input1: text which contants path information
264             Input2: the path length you want to show
265             Ex:
266             $pt->path_extract($path, $length);
267              
268             =cut
269             sub path_extract {
270             my $self=shift;
271             my $path = shift;
272             my $length = shift;
273             #my $splited = shift;
274             my @a;
275             my @path_line;
276              
277             my $p;
278             #if($splited eq "splited"){
279             while($path =~ m'(^\s+[\-0-9a-zA-Z./_]+/[\-0-9a-zA-Z./_]+.*? [fr])'gsm){
280             $p = $1;
281             $p =~ s/\n//;
282             # if($p !~ /0\.0000/){
283             push @a, $p;
284             # }
285             };
286             #}else{
287             # @path_line = split(/\n/,$path);
288             # @a = grep m'^\s+[\-0-9a-zA-Z./_]+/[\-0-9a-zA-Z./_]+', @path_line;
289             #}
290              
291             # remove * in each path
292             for (@a) {s/\*//};
293              
294            
295             my @path_2D;
296             @path_2D = map {[split]} @a;
297              
298              
299             for my $aref (@path_2D){
300             @$aref[0] = substr(@$aref[0], -$length);
301             }
302              
303             return @path_2D;
304             }
305             # }}}
306             # clk_path
307             # {{{
308              
309             =head2 clk_path
310              
311             Input1: text which contants clock path information
312             Input2: "source" or "capture"
313             Ex:
314             $pt->clk_path($clock_path, "source");
315              
316             =cut
317             sub clk_path {
318             my $self=shift;
319             my $path_no = shift;
320             my $type = shift;
321             $path_no--;
322              
323             my $tb = Text::Table->new();
324              
325             my @p_ref;
326             if($type eq "source"){
327             @p_ref = $self->path_extract($self->{paths}->{$path_no}->{clock_path_source}, 110);
328             }
329             elsif($type eq "capture"){
330             @p_ref = $self->path_extract($self->{paths}->{$path_no}->{clock_path_capture}, 110);
331             }
332              
333             for (@p_ref) {
334             $tb->load([@$_]);
335             }
336              
337             print $tb;
338             }
339             # }}}
340              
341             =head1 Tools
342              
343             Three tools provided as gedgets and also examples using PrimeTime::Report.
344              
345             =head2 pr-summary.pl
346              
347             =head2 pr-path.pl
348              
349             =head2 pr-clk_path.pl
350              
351             =head1 AUTHOR
352              
353             yorkwu, Eyorkwuo@gmail.com
354              
355             =head1 COPYRIGHT AND LICENSE
356              
357             Copyright (C) 2010 by yorkwu
358              
359             This library is free software; you can redistribute it and/or modify
360             it under the same terms as Perl itself, either Perl version 5.8.5 or,
361             at your option, any later version of Perl 5 you may have available.
362              
363              
364             =cut
365             1;
366             # vim:fdm=marker