#!/bin/perl
$htdocs="/work2/ben/WWW/";

# $Log: compfact,v $
# Revision 1.1  2002/04/16 20:55:03  danbri
# company accounts test data
#
# Revision 1.2  1997/01/03 01:04:46  ecdb
# fixed template and file to live in same directory.
#
# Revision 1.1  1997/01/03 00:55:46  ecdb
# Initial revision
#
# Revision 1.1  1996/01/08  09:11:52  joel
# Initial revision
#

$RCSID='$Id: compfact,v 1.1 2002/04/16 20:55:03 danbri Exp $';

# Location of the data file and HTML formatted template


$HOME_DIR="/work2/ben/cgi-files/compstats/";
$PROJECT="crp"; # default to Company Report Profiler project 
$DATA_DIR = $HOME_DIR . $PROJECT . "/";

# DEFAULT FOR OUTPUT
$FORMAT="YES";

# DEFAULT FOR BORDER
$BORDER="BORDER";

# Initialise calculation matrix
$Calc{'RNA'}="&RNA()"; # Return on Net Assests = Operating Profit/Net Assets
$Calc{'PM'}="&PM()";  # Profit Margin = Operating Profit/Sales Revenue
$Calc{'AT'}="&AT()"; # Asset Turnover = Sales/Net Assets
$Calc{'SPE'}="&SPE()"; # Sales per Employee = Sales/Number of Employees
$Calc{'OPPE'}="&OPPE()"; # Operating Profit per Employee = Operating Profit/Number of Employees
$Calc{'NUKSR'}="&NUKSR()"; # Non UK Sales = Non UK Sales/Total Sales
$Calc{'CR'}="&CR()"; # Current Ratio = Current Assets/Current Liabilites
$Calc{'ATR'}="&ATR()"; # (Current Assets - Stocks) /Current Liabilities
$Calc{'DD'}="&DD()"; # Debtor Days = Debtors/Sales/365
$Calc{'SD'}="&SD()"; # Stock Days = Stocks/Cost of Sales/365
$Calc{'G'}="&G()"; # Gearing = Long term Liabilities/Shareholders Funds
$Calc{'IC'}="&IC()"; # Interest Cover = Operating Profit / Interest
$Calc{'DC'}="&DC()"; # Dividend Cover = Profit Attributable / Dividends Paid
$Calc{'CA'}="&CA()"; # Current Assets : total

# Read any parameters we may have been given into QUERY_STRING.
# This can be passed either directly in QUERY_STRING, in which case
# we don't do anything, otherwise we read them from STDIN.
if($ENV{'CONTENT_LENGTH'}) {
   open(IN,"-");
   read(IN,$ENV{'QUERY_STRING'},$ENV{'CONTENT_LENGTH'});
   close(IN);
   }

# Query holds the 'query string' - historically named. 
# This contains all of the state information from the client.
# Split it up into 'attribute/value pairs'
$Query = $ENV{'QUERY_STRING'};
foreach $pair (split(/&/,$Query)) {
   ($name,$value)=split(/[ =]/,$pair,2);
   $name=&unesc($name);
   $name=~tr/a-z/A-Z/;
   $Query{$name}.=",".&unesc($value) if ($Query{$name} ne "");
   $Query{$name}=&unesc($value) if ($Query{$name} eq "");
   }


Require("FILE","No statistics group to browse.");
Require("SOURCE","No sources to browse.");
Require("YRSTART","No start year.");
Require("YREND","No end year.");
Require("VARIABLES","No variables to display.");




if ($Query{'PROJECT'}) { 
	$PROJECT = $Query{'PROJECT'};
	$PROJECT = s/\.\.//g;
	$DATA_DIR = $HOME_DIR . "$PROJECT/";
	}

if ($PROJECT eq "" ) { 
	Error ("no project named: $PROJECT \n  $Query{'PROJECT'}"); 
	}

$DATA_FILE = $DATA_DIR.$Query{'FILE'};

if($Query{'FORMAT'}) 
{
    $FORMAT=$Query{'FORMAT'};
}

open(INFILE,$DATA_FILE);
@data=<INFILE>;
close(INFILE);

# Fetch first line of file into $Header ignoring any line starting
# with a '#' sign for comments.
while($Header=shift @data)
{
    push(@blurb,$Header),next if $Header=~/^ *!/;
    last if $Header!~/^ *#/;
}

@Headers=split(",",$Header);
$I=0;
foreach $column (@Headers)
{
    $Index{$column}=$I++;
}

if(! defined $Index{'YEAR'}) 
{
    &Error("'YEAR' not found in data header.");
}

# Extract relevent information by date
@data=grep(&Datecheck($_,$Index{'YEAR'}),@data);

@sources=split(",",$Query{'SOURCE'});
foreach $source (@sources)
{
    $srchash{$source}=1;
}

# Extract relevent information by source
if(! defined $Index{'SOURCE'})
{
    &Error("'Source' not found in data header.");
}

@data=grep(&SourceCheck($_,$Index{'SOURCE'}),@data);

# Output the data
unshift(@data,$Header);
chop(@data);

if($FORMAT eq "HTML")
{
    print "Content-Type: text/html\n\n";
}
elsif($FORMAT eq "TEXT")
{
    print "Content-Type: text/plain\n\n";
}
else
{
    print "Content-Type: application/octet-stream\n\n";
}                              

@dataout=();
if($FORMAT eq "HTML")
{
    push(@dataout,"<TABLE $BORDER cellpadding=4 cellspacing=0>");
}

@Vars=split(",",$Query{'VARIABLES'});

unshift (@Vars,"YEAR");
unshift (@Vars,"SOURCE");

$inHeader=1;
foreach $datum (@data)
{
    @elements=split(",",$datum);
    @output=();
    foreach $var (@Vars) {
        push(@output,$elements[$Index{$var}]) if defined $Index{$var};
        push(@output,eval($Calc{$var})) if defined $Calc{$var};
    }
    if($FORMAT eq "HTML")
    {
	push(@dataout,"<TR><TD>".join("</TD><TD>",@output)."</TD>")."</TR>\n";
    }
    else 
    {
        print join(",",@output);
        print "\n";
    }
    $inHeader=0;
}

if($FORMAT eq "HTML")
{
    push(@dataout,"</TABLE>");
    undef $/;
    open(INFILE,"<".$DATA_DIR.$Query{'TEMPLATE'});
    $template=<INFILE>;
    close INFILE;
    $template=~s/%%RESULTS/@dataout/;
    print &ssi($template);
}

exit;

# Subs

sub Error {
    local($msg)=@_;
    print "Content-Type: text/html\n\n";
    print "<HTML><HEAD><TITLE>Profiler Error!</TITLE></HEAD></HTML>";
    print "<BODY>";
    print "<H1>Statistics Error !</h1>";
    print "<p><b>$msg</b></p>";
    print "<p>This error may be caused by you accessing this page ";
    print "by typing the location (URL) in directly. If this is the ";
    print "the case, please access this search though the search ";
    print "front page.</p>";
    print "If this is not the case, then please report this error ";
    print "to the site maintainer.</p>";
    print "</BODY>";
    print "</HTML>";
    exit;
}

sub Require {
    local($val,$msg)=@_;

    &Error($msg) if ! $Query{$val};
    return;
}

# Given a text string as a parameter, undo any escape sequences
# to recover the original string, and then return it.
sub unesc {
    local($str) = @_;
    $str =~ s/\+/ /g;
    $str =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/eg;
    return $str;
}

sub Datecheck {
    local($line,$datecol)=@_;
    
    @line=split(",",$line);
    $line[$datecol]>=$Query{'YRSTART'} && $line[$datecol]<=$Query{'YREND'};
}

sub SourceCheck
{
    local($line,$SourceCol)=@_;
  
    @line=split(",",$line);
    ($srchash{$line[$SourceCol]});

} 

sub RNA
{             
    return("RNA") if($inHeader);
    return("*") if ($elements[$Index{'NA'}]==0); # NULL trap
    return(sprintf("%.2f",$elements[$Index{'OPOA'}]/$elements[$Index{'NA'}]*100));
}

sub PM
{ 
    return("PM") if($inHeader);
    return("*") if ($elements[$Index{'SR'}]==0); # NULL trap
    return(sprintf("%.2f",$elements[$Index{'OPOA'}]/$elements[$Index{'SR'}]*100));
}

sub AT
{ 
    return("AT") if($inHeader);
    return("*") if ($elements[$Index{'NA'}]==0); # NULL trap
    return(sprintf("%.2f",$elements[$Index{'SR'}]/$elements[$Index{'NA'}]));
}

sub SPE
{ 
    return("SPE") if($inHeader);
    return("*") if ($elements[$Index{'NOE'}]==0); # NULL trap
    return(sprintf("%.2f",$elements[$Index{'SR'}]/$elements[$Index{'NOE'}]*1000000));
}

sub OPPE
{ 
    return("OPPE") if($inHeader);
    return("*") if ($elements[$Index{'NOE'}]==0); # NULL trap
    return(sprintf("%.2f",$elements[$Index{'OPOA'}]/$elements[$Index{'NOE'}]*1000000));
}

sub NUKSR
{ 
    return("NUKSR") if($inHeader);
    return("*") if ($elements[$Index{'SR'}]==0); # NULL trap
    return(sprintf("%.2f",$elements[$Index{'NUKSV'}]/$elements[$Index{'SR'}]*100));
}

sub CR
{ 
    return("CR") if($inHeader);
    return("*") if ($elements[$Index{'CL'}]==0); # NULL trap
    return(sprintf("%.2f",&CA()/$elements[$Index{'CL'}]));
}

sub ATR
{ 
    return("ATR") if($inHeader);
    return("*") if ($elements[$Index{'SR'}]==0); # NULL trap
    return(sprintf("%.2f",($elements[$Index{'CAD'}]+$elements[$Index{'CAC'}])/$elements[$Index{'CL'}]));
}

sub CA
{ 
    return("CA") if($inHeader);
    return(sprintf("%.2f",$elements[$Index{'CAS'}]+$elements[$Index{'CAD'}]+$elements[$Index{'CAC'}]));
}

sub DD 
{
    return("DD") if($inHeader);
    return("*") if ($elements[$Index{'SR'}]==0); # NULL trap
    return(sprintf("%.2f",($elements[$Index{'CAD'}]*100000/$elements[$Index{'SR'}])/365));
}

sub SD 
{
    return("SD") if($inHeader);
    return("*") if ($elements[$Index{'SR'}]==0); # NULL trap
    return(sprintf("%.2f",($elements[$Index{'CAS'}]*100000/$elements[$Index{'COS'}])/365));
}

sub G
{
    return("G") if ($inHeader);
    return("*") if ($elements[$Index{'SF'}]==0); # NULL trap
    return(sprintf("%.2f",$elements[$Index{'LTL'}]/$elements[$Index{'SF'}]*100));
}


sub IC
{
    return("IC") if ($inHeader);
    return("*") if ($elements[$Index{'I'}]==0); # NULL trap
    return(sprintf("%.2f",$elements[$Index{'OPOA'}]/$elements[$Index{'I'}]));
}

sub DC
{
    return("DC") if ($inHeader);
    return("*") if ($elements[$Index{'DP'}]==0); # NULL trap
    return(sprintf("%.2f",$elements[$Index{'PATC'}]/$elements[$Index{'DP'}]));
    
}



#######################################################
# Subroutine to return text of a file given its name
# required $htdocs

sub getfiletxt {
   local($file) = $_[0];
   local($filecontents)="";
    $pr="";
    foreach (@_) { $pr = $pr.$_; }
    $file =~ s/\.\.//g;
    open (FILE, "$htdocs.$file"); 
    foreach (<FILE>) { $filecontents = $filecontents.$_; }
    close(FILE);
    return $filecontents;
    }

sub ssi {
 #does three passes of SSI inclusion
 local ($page) = $_[0];
 local ($loop)=0;
 while($loop<3)
   {
   $loop++;
   $page =~ s/(<!--#include virtual=\")(.+)(\"-->)/&getfiletxt($2)/eg;
   }
  return $page;
 }


############################