#!perl -w
require 5.004;

=head1 NAME

FP.pl - Will Mengarini <seldon@eskimo.com> - Quick function point calculation

=head1 LAYOUT

I prefer something similar to Knuth's "literate programming", in which
documentation is intermingled with code.  So what this module does is
explained in a help message rather than POD documentation, & the function
giving that message is the first code you'll see.  That might make things
difficult for a POD-translator to handle, but I think it's worth it to make
reading the raw source code easier.  Primarily I just use POD as a multiline
comment delimiter.

=cut

sub usage {
  print <<EOT
FP is a Perl script that calculates feature points or function points, which
are software metrics intended to give a scalar measure of quantity of
functionality in software.  It does this by requiring you to answer a series
of questions about the software, & applying a formula to your answers.

The first argument is the name of the code unit being measured; a suitable
example would be a filename.  This is used as a key to store your metric
in a database.  If you've previously defined values for this metric for
this code unit, they're looked up & used as the defaults for this
redefinition, so you can easily tweak.  Use "0" as the name of the code unit
if you don't want the data stored, but just want to calculate a metric
without looking up previous values (defaults will all be 0).  If you do
want the data stored, there must exist a %HOME% environment variable naming
the directory that will contain the file "fp.dat".

The particular questions & formula depend on the particular metric you
choose, & it's the first command-line argument.  These metrics are supported:
  ibm84 -- The original 1984 IBM definition of function points
<sigh> That's all so far.

Example:
  Perl -S fp.pl HelloWorld.cpp ibm84
calculates & stores 1984 IBM function points for the program HelloWorld.cpp.
EOT
}

=head1 DESIGN RATIONALE

Storing the database out of band is best, so it can be used on other people's
code in industrial contexts.  This is even a good idea for nonindustrial
code, since if it becomes freeware I don't want it crufted up.

=cut

# Selftest capabilities need to come before setting up strict & diagnostics.
# The only selftesting in this script is of minor subs like validators (see
# my ask.pl) & encryptors (see my ttyForm.pl).

require 'selftest.pl';
require 'ask.pl';
require 'ttyForm.pl';
&maybeSelfTest;

# If this script uses strict & diagnostics, it takes > 10 seconds to load
# on a 486/50 running Windows 95; without them, it takes 1..2 seconds.
# Here is a general approach to being able to toggle that from outside
# the script without editing it.

my $debug; #set in next BEGIN block

BEGIN { #decide whether to set $debug & use {strict,diagnostics}
  if( defined $ENV{'PERLHACK'} ){
    $_ = $0; s|.*[/\\]||; s|\.pl$||i; #Extract script name from file path
    if( $ENV{'PERLHACK'} =~ /\b$_\b/i ){ #If it's a word in $PERLHACK
      print "Running $_ with strict everything & diagnostics.\n";
      $debug = 1;
      # Can't use "use" here because they'd generate a separate BEGIN block:
      require 'strict.pm'; import strict;
      require 'diagnostics.pm'; import diagnostics;
    }else{
      $debug = 0;
    }
    undef $_;
  }
}

# Subs from packages ask & ttyForm:

sub askYN;
sub updateLoop;

# The main code just applies the selected metric to the selected code unit.
# There need to be 2 args, the code unit & the metric.  The code unit is
# first since it seems more likely that I'll want to run multiple metrics on
# a single code unit than one metric on multiple units, at least while I'm
# still hacking the metrics to find one I like.  If I married one metric I'd
# define a DOSKey alias that just ran FP with that metric.

defined $ARGV[1] or usage and exit 1;
my( $codeUnit, $metric ) = @ARGV[0..1];

# If we're using a database, we need to find the most recent entry in it that
# pertains to this code unit & metric, & extract it.  Then, whether or not
# we're using a database, we need to create a new entry in database format,
# because a screen display of that is an output of this script (& if there's
# no database, it's the only output).

sub findDatabase;
sub getMostRecentEntry;
sub makeNewEntry;

my $database = $codeUnit eq '0' ? '' : findDatabase;
   # The path to the database if we're using one, but in effect also
   # a boolean indicating whether we're using a database.

my $mostRecentEntry = getMostRecentEntry $codeUnit, $metric, $database;
my $newEntry = makeNewEntry $codeUnit, $metric;

# Next we just pick the relevant metric & calculate it.

if( $metric eq 'ibm84' ){
  sub ibm84;
  $newEntry .= ibm84 $mostRecentEntry;
}else{
  die "No \"$metric\" metric is defined.\n";
}

# Finally, we display the calculated entry to the user, & ask whether
# to append it to the database.

print $newEntry,$/;

sub putNewEntry;

if( $database && askYN "Write this entry to database? " ){
  putNewEntry $newEntry, $codeUnit, $metric, $database;
}

# The database must be located in $HOME, so that environment variable
# must be defined for the database to be found.  However, if the database
# is known not to be wanted for this run (because the code unit is '0'),
# the main code shouldn't call findDatabase, so $HOME won't be needed.

sub findDatabase {
  my $HOME = $ENV{'HOME'} or die "Environment variable HOME not found.\n";
  $HOME =~ s|([^/\\])$|$1/|; #"/" works on both Unix & Windows
  my $database = "${HOME}fp.dat";
  if( -e $database && ! -f _ ){
    die "\"$database\" exists & is not a normal file.\n";
  }elsif( ! -f _ ){
    if( askYN "$database doesn't exist; create? " ){
      open DB, ">$database" or die "Unable to create $database.\n";
      close DB;
    }else{
      print "Aborting.\n"; exit 1;
    }
  }
  $database
}

# The trick to getMostRecentEntry is to pick off the *final* entry in
# the database that matches the relevant criteria.  It seems easiest to
# read from the beginning, remembering the most recently found match.

sub getMostRecentEntry {
  my( $codeUnit, $metric, $database ) = @_;
  die unless defined $database;
  return '' unless $database;
  open DB, $database or die "Can't open $database: $!";
  my( $entry, $scratch ) = ( '', '' );
  my $weAreReadingACandidateEntry = 0;
  while( <DB> ){
    if( /^====+$/ ){
      # This is a start of a new entry
      if( $weAreReadingACandidateEntry ){
        # We were already reading a candidate entry, which now is finished
        $entry = $scratch; #overwriting any previous value in $entry
        $weAreReadingACandidateEntry = 0; #because the old entry is finished
      }
      $scratch = $_;
    }elsif( /^Code unit $codeUnit, metric $metric$/ ){
      $weAreReadingACandidateEntry = 1;
      $scratch .= $_;
    }elsif( $weAreReadingACandidateEntry ){
      $scratch .= $_;
    }else{
      $scratch = '';
    }
  }
  $entry = $scratch if $weAreReadingACandidateEntry;
  close DB;
  $entry
}

# The "database" is just a flat text file containing entries with headers
# that identify the code unit, the metric that was applied to it, & when.
# This allows using an editor to annotate the calculations; that capability
# is important, since the metrics include subjective judgments.

sub timestamp;

sub makeNewEntry {
  my( $codeUnit, $metric ) = @_;
  die unless defined $metric;
  $codeUnit = "[anonymous]" unless $codeUnit; #so it replaces '0'
  "\n===============\nCode unit $codeUnit, metric $metric\n---------------\n"
    . "Calculated on " . timestamp
}

# It'd be possible to go thru the database for any previous entry pertaining
# to this code unit & metric, & replace it with the new entry; but I'd rather
# do that pruning in an editor, since I may want to keep multiple records
# applying a particular metric to a particular code unit, with annotations
# describing differences in subjective judgments.

sub putNewEntry {
  my( $newEntry, $codeUnit, $metric, $database ) = @_;
  die unless defined $database;
  # In this incarnation I just catenate $newEntry onto the end of the
  # "database", so I don't need to know about $codeUnit or $metric.  That
  # could change someday, so this calling protocol should be maintained.
  open DB, ">>$database" or die "Can't open $database: $!";
  print DB $newEntry;
  close DB;
}

sub timestamp {
  my @dayName = qw(Sa Su Mo Tu We Th Fr);
  my @monthName = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
  my ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime(time);
  sprintf "%02d:%02d:%02d %s %02d %s %02d\n",
         $hour, $min, $sec, $dayName[$wday], $mday, $monthName[$mon], $year;
}

# getValuesOf $whatToGet will extract from $entry the last line that has a
# /^$whatToGet: / prefix, with that prefix removed; or '' if there is no such
# line.  The reason for going to the trouble of extracting the last item is
# that I'm allowing for the possibility that I'll someday use a database
# format in which multiple calculations of a metric go in one $entry.
# To grok the code, remember that s/// returns true if it changes anything.

sub getValuesOf {
  my( $whatToGet, $entry ) = @_;
  die unless defined $entry;
  my @matches = grep s/^$whatToGet: //, split /\n/, $entry;
  @matches ? $matches[$#matches] : ''
}

# ibm84 metric: described in Jones /Applied Software Measurement/ p64.
# Here I implement it with 2 separate subs, to allow for the possibility
# that I'll develop other metrics using one of those subs.

sub ibm84Basics;
sub ibm84Complexity;

sub ibm84 {
  my( $mostRecentEntry ) = @_;

  my $defaults; #Scratch for 2 calculations
  my $result = ''; #User input & calculations from it, all in database format

  $defaults = getValuesOf 'ibm84Basics', $mostRecentEntry;
  my( $unadjustedFunctionPoints, $basicsString ) = ibm84Basics $defaults;
  $result .= $/ . 'ibm84Basics: ' . $basicsString;

  $defaults = getValuesOf 'ibm84Complexity', $mostRecentEntry;
  my( $complexityFactor, $complexityString ) = ibm84Complexity $defaults;
  $result .= $/ . 'ibm84Complexity: ' . $complexityString;

  my $functionPoints = $unadjustedFunctionPoints * $complexityFactor;
  $result .= $/ . "IBM 1984 Function Points: " . $functionPoints . $/;

}

sub isWhole; #validator sub as described in my ask.pl package

sub sum;

# ibm84Basics uses updateLoop from my ttyForm.pl package to present the
# user with a purely text-mode form to fill out.

sub ibm84Basics {
  my $defaults = shift || join '|', ('0') x 15;

  print "\nIBM 84 Function Point Basic Parameters---\n\n";
  print "All values must be nonnegative integers.\n";

  my $newValueString = updateLoop '|',$defaults,split( "\n\n", <<EOD );
same;same;isWhole
Number of low-complexity external input types
Examples of external input types include data screens filled out by users,
magnetic tapes, floppy disks, sensor inputs, & mouse inputs.
The 1990 IFPUG (International Function Point User's Group) rules count
duplicate inputs twice; for example, a banking system which accepts a
deposit via an ATM or a manual method would count this as 2 input types.
LOW COMPLEXITY means 1-5 data element types.

same;same;isWhole
Number of medium-complexity external input types
Number of low-complexity external input types
Examples of external input types include data screens filled out by users,
magnetic tapes, floppy disks, sensor inputs, & mouse inputs.
The 1990 IFPUG (International Function Point User's Group) rules count
duplicate inputs twice; for example, a banking system which accepts a
deposit via an ATM or a manual method would count this as 2 input types.
MEDIUM COMPLEXITY means 5-15 data element types.

same;same;isWhole
Number of high-complexity external input types
Number of low-complexity external input types
Examples of external input types include data screens filled out by users,
magnetic tapes, floppy disks, sensor inputs, & mouse inputs.
The 1990 IFPUG (International Function Point User's Group) rules count
duplicate inputs twice; for example, a banking system which accepts a
deposit via an ATM or a manual method would count this as 2 input types.
HIGH COMPLEXITY means 16 or more data element types.

same;same;isWhole
Number of low-complexity external output types
Examples of external output types include output data screens, disk files,
sets of checks, or printed invoices.
The 1990 IFPUG rules count each output medium separately; for example, a
report that can be sent either to a printer or a disk file counts as 2.
LOW COMPLEXITY means 1-5 data element types.

same;same;isWhole
Number of medium-complexity external output types
Examples of external output types include output data screens, disk files,
sets of checks, or printed invoices.
The 1990 IFPUG rules count each output medium separately; for example, a
report that can be sent either to a printer or a disk file counts as 2.
MEDIUM COMPLEXITY means 6-19 data element types.

same;same;isWhole
Number of high-complexity external output types
Examples of external output types include output data screens, disk files,
sets of checks, or printed invoices.
The 1990 IFPUG rules count each output medium separately; for example, a
report that can be sent either to a printer or a disk file counts as 2.
HIGH COMPLEXITY means 20 or more data element types.

same;same;isWhole
Number of low-complexity internal logical files
Examples of internal logical files include temporary disk files, flat files
in a personal computer database, one table in a relational database,
one leg in a hierarchical database such as IBM's IMS, or one path through
a net in a network-oriented database.
LOW COMPLEXITY means 1-19 data element types.

same;same;isWhole
Number of medium-complexity internal logical files
Examples of internal logical files include temporary disk files, flat files
in a personal computer database, one table in a relational database,
one leg in a hierarchical database such as IBM's IMS, or one path through
a net in a network-oriented database.
MEDIUM COMPLEXITY means 20-50 data element types.

same;same;isWhole
Number of high-complexity internal logical files
Examples of internal logical files include temporary disk files, flat files
in a personal computer database, one table in a relational database,
one leg in a hierarchical database such as IBM's IMS, or one path through
a net in a network-oriented database.
HIGH COMPLEXITY means 51 or more data element types.

same;same;isWhole
Number of low-complexity external interface file types
Examples of external interface files include shared databases & files
addressable from multiple applications.
LOW COMPLEXITY means 1-19 data element types.

same;same;isWhole
Number of medium-complexity external interface file types
Examples of external interface files include shared databases & files
addressable from multiple applications.
MEDIUM COMPLEXITY means 20-50 data element types.

same;same;isWhole
Number of high-complexity external interface file types
Examples of external interface files include shared databases & files
addressable from multiple applications.
HIGH COMPLEXITY means 51 or more data element types.

same;same;isWhole
Number of low-complexity external inquiry types
Examples of inquiries include user inquiry into file contents without update,
help messages, & selection messages.  1990 IFPUG includes menus.
LOW COMPLEXITY means 1-4 data element types.

same;same;isWhole
Number of medium-complexity external inquiry types
Examples of inquiries include user inquiry into file contents without update,
help messages, & selection messages.  1990 IFPUG includes menus.
MEDIUM COMPLEXITY means 5-15 data element types.

same;same;isWhole
Number of high-complexity external inquiry types
Examples of inquiries include user inquiry into file contents without update,
help messages, & selection messages.  1990 IFPUG includes menus.
HIGH COMPLEXITY means 16 or more data element types.
EOD

  print "\$newValueString: \"$newValueString\"\n" if $debug;

  my @newValueList = split /\|/, $newValueString;

  print "\@newValueList: ",join( ',', @newValueList ),$/ if $debug;

  my @multipliers = (
                      3,  4,  6,
                      4,  5,  7,
                      7, 10, 15,
                      5,  7, 10,
                      3,  4,  6,
                    );
  print "\@multipliers: ",join( ',', @multipliers ),$/ if $debug;

  die unless @newValueList == @multipliers;

  my $unadjustedFunctionPoints = 0; #not yet adjusted for complexity
  for( my $i = 0; $i < @multipliers; ++$i ){
    $unadjustedFunctionPoints += $newValueList[$i] * $multipliers[$i];
  }

  ( $unadjustedFunctionPoints, $newValueString );

}

sub ibm84Complexity {

  my $defaults = shift || join '|', ('0') x 14;
     # formerly: my $defaults = shift || (en93 0) x 14;

  print "\nIBM 84 Function Point Complexity adjustment---\n\n";
  print "Complexity factors may have one decimal place.\n";
  print "All factors must be in range 0..5; 5 denotes maximum complexity.\n";

  my $newValueString = updateLoop '|',$defaults,split( "\n\n", <<EOD );
same;same;inRange(0,5)
Data communication
Data and/or control information sent or received over communication lines.
0 = Batch app
1 = Remote printing or data entry
2 = Remote printing and data entry
3 = App has a teleprocessing front end
4 = App has significant teleprocessing
5 = App is predominantly teleprocessing
[Using this in the 90s, "teleprocessing" should mean network functionality.]

same;same;inRange(0,5)
Distributed functions
The extent to which the app is distributed among a variety of processors.
[I assume that was intended to mean a variety of computers.]
0 = Pure monolithic app
1 = App prepares data for other components
2 = App distributed over a few components
3 = App distributed over more components
4 = App distributed over many components
5 = App dynamically performed on many components

same;same;inRange(0,5)
Performance objectives
0 if no special performance criteria are stated by the users of the app;
5 if users insist on very stringent performance targets that require
considerable effort to achieve.

same;same;inRange(0,5)
Heavily used configuration
0 if the app has no special usage constraints, 5 if anticipated usage
requires special effort to achieve.

same;same;inRange(0,5)
Transaction rate
0 if the volume of transactions is not significant, 5 if it's high enough
to stress the app & require special effort to achieve desired thruput.

same;same;inRange(0,5)
Online data entry
0 if fewer than 15% of the transactions are interactive,
5 if more than 50% are.

same;same;inRange(0,5)
End-user efficiency
0 if there are no end users or they have no special requirements, 5 if the
stated requirements for end-user efficiency are stringent enough to require
special effort to achieve them.  [Compare "performance objectives" above;
what's the difference?]

same;same;inRange(0,5)
Online update
0 if there's none, 5 if online updates are both mandatory & especially
difficult, perhaps because of the need to back up or protect data against
accidental change.

same;same;inRange(0,5)
Complex processing
0 if there's none, 5 in cases requiring extensive logical decisions,
complicated mathematics, tricky exception processing, or elaborate security
schemes.

same;same;inRange(0,5)
Reusability
0 if the functionality is planned to stay local to the current app, 5 if much
of the functionality & the project deliverables are intended for widespread
utilization by other apps.

same;same;inRange(0,5)
Installation ease
0 if this factor is insignificant, 5 if installation is both important & so
stringent that it requires special effort to accomplish satisfactorily.

same;same;inRange(0,5)
Operational ease
0 if this factor is insignificant, 5 if operational ease of use is so
important that it requires special effort to achieve it.

same;same;inRange(0,5)
Multiple sites
0 if there is only 1 planned using location, 5 if the project & its
deliverables are intended for many diverse locations.

same;same;inRange(0,5)
Facilitation of change
0 if change doesn't occur, 5 if the app is developed specifically to allow
end users to make rapid changes to control data or tables which they maintain
with the aid of the app.
EOD

  my @newValueList = split /\|/, $newValueString;
     # formerly: my @newValueList = map { de93 } split '', $newValueString;

  my $complexityAdjustment = (sum @newValueList) * .01 + .65;

  ( $complexityAdjustment, $newValueString )
}

sub isWhole {
  no strict; #validators for ask.pl refer to global $value
  if( $value =~ /^\d+$/ ){
    (1)
  }else{
    (0, "\"$value\" isn't a nonnegative integer.\n");
  }
}

sub sum {
  my @list = @_;
  my $sum = 0;
  for( my $i = 0; $i < @list; ++$i ){
    $sum += $list[$i];
  }
  $sum
}

# These are a decryptor & encryptor for storing values in 0.0 .. 9.3
# as single Ascii digits.  I got tired of this code & starting using
# &same instead, but the code works & could be used if the compression
# were needed.

sub de93 {
  my $arg = defined $_[0] ? $_[0] : $_;
  sprintf "%01.1f", (  (ord $arg) - 33  ) / 10
}

sub en93 {
  my $arg = defined $_[0] ? $_[0] : $_;
  chr int( $arg * 10 ) + 33
}

__END__
__TESTCODE__
die unless 30 == sum 1,4,9,16;
die unless 14916 == sum 14916;
die unless 0 == sum ();

die unless de93('!') eq "0.0";
die unless en93('0.0') eq '!';
die unless en93('0') eq '!';
die unless en93('00') eq '!';

die unless de93('"') eq "0.1";
die unless en93('0.1') eq '"';
die unless en93('.1') eq '"';
die unless en93('.10') eq '"';
die unless en93('.10000') eq '"';

die unless de93('S') eq "5.0";
die unless en93('5.0') eq 'S';
die unless en93('5.') eq 'S';
die unless en93('5') eq 'S';
die unless en93('5.1') eq 'T';
die unless en93('5.11') eq 'T';

die unless de93('~') eq "9.3";
die unless en93('9.3') eq '~';

print "Selftest successful.\n";
exit 0;