#!/usr/bin/perl -w

use strict;
use FileHandle;

sub Info
{
    my ( $Opts, $Dirs, $DirNum, $File ) = @_[0..3];

    my $root = $Opts->{ 'root' } || '';

    if( defined( $Opts->{ 'references' }[2] ) )
    {
        my $h = require( $Opts->{ 'references' }[2] );
        $h == 1  or $main::refpl = $h;
    }

    if( defined( $Opts->{ 'hash' } ) )
    {
        my $h = require( $Opts->{ 'hash' } );
        $h == 1  or $main::hash= $h;
    }

    $DirNum >= 0 and defined( $Dirs->[ $DirNum * 2 + 1 ] ) or
        do { Head($Opts); print "Wrong \"$DirNum\", possible attack!\n"; return;};

    $File =~ /^\w+.m$/ or $File =~ /^private\/\w+.m$/ or
        do { Head($Opts); print "Wrong \"$File\", possible attack!\n"; return; };

    
    my $fh = new FileHandle;

    $fh->open( $Dirs->[$DirNum * 2 + 1] . $File ) or do { 
        Head($Opts); print "Cannot open \"$Dirs->[$DirNum * 2 + 1]$File\"\n"; 
        return; };

    my $rh = $Opts->{'raw_head'};

    if( defined( $Opts->{'css'} ) )
    {
        if( ref( $Opts->{'css'} ) ne 'ARRAY' ) 
        {$Opts->{'css'} = [ $Opts->{'css'} ]; }

        foreach my $css ( @{$Opts->{'css'}} )
        {
            $Opts->{'raw_head'} .=
                "<link rel=\"stylesheet\" type=\"text/css\" href=\"$css\">\n";
        }
    }
    else
    {
        $Opts->{'raw_head'} .=  $Opts->{'info_css'} ||
            "  <STYLE TYPE=\"text/css\">\n" .
        "    .help    { color: black;  }\n" .
        "    .help_field  { color: black; font-weight: bold }\n" .
        "    .also_field  { color: black; font-weight: bold }\n" .
        "    .also  { color: black; }\n" .
        "  </STYLE>\n";
    }


    my ($name, $desc) = GetH1( $fh );

    if( !defined( $desc ) )
    {
        Head($Opts);
        print $name;
        $Opts->{'raw_head'} = $rh;
        return;
    }

    $main::Opts->{ 'title' } = $name;

    Head($Opts);
    $Opts->{'raw_head'} = $rh;

    print "<body>\n";
    print "<table  border=0 width=\"100%\" ".
        "cellpadding=0 cellspacing=0><tr valign=\"baseline\">\n";
    print "<td valign=\"baseline\" class=\"function\"><b class=\"function\">$name</b>\n";
    print "<td valign=\"baseline\" align=\"right\" class=\"function\"><a href=\"" . 
        HrefDir( $Opts, $Dirs, $DirNum * 2) . 
            "\" target=\"mdsdir\"><img border = 0 src=\"style/up.gif\">" .
                "</a></table>\n";

    print "  <p><b>$desc</b></p>\n";
    print "  <hr>\n";

    print "<div class='code'><code>\n";
    HilitHelp( $fh, $Opts );

    print "</code></div>\n";
    print "  <hr>\n";
    my $Info = m_info( $fh );
    print "  <b>Source:</b> <a href= \"" . HrefList( $Opts, $DirNum, $File ) .
        "\">$File</a>\n";

    defined( $Info->{'(c)'} ) && PrBR( $Info->{'(c)'}, '(c) ' );



    for( my $Fld = 0; $Fld < $#{$Opts->{ 'fields' } }; $Fld += 2 )
    {
        defined( $Info->{$Opts->{ 'fields' }[$Fld]} ) &&
            PrBR( $Info->{$Opts->{ 'fields' }[$Fld]}, 
                  $Opts->{ 'fields' }[$Fld+1] );
    }

    defined( $Info->{'Requires'} ) && PrBR( $Info->{'Requres'}, 'Requires:' );
    defined( $Info->{'last change'} ) && do {
        $Info->{'last change'} =~ s/^\s*\$Date:\s*(\S+)[^\$]*\$\s*/$1 /;
        $Info->{'last change'} =~ s/\$Revision:\s*([^\$]+)\$\s*/(Rev: $1)/;

        PrBR( $Info->{'last change'}, 'Last change:' );
    };
    print "</body>\n</html>\n";

}

sub PrBR
{
    $_ = shift;

    s/\\\s*\n/ /g;

    s/\n/<br>\n/g;
    print "  <p><b class=\"info_field\">" . $_[0] . "</b> $_\n";
}


#===============================================================================
sub GetH1 # Find and parse H1 line
{
    my $fh = shift;

    while( $_ = $fh->getline() ) { /^\%/ && do { 
        $_ = $';
        /^\s*(\S+)\s+(\S.*)$/ || return "Syntax error of the H1 line";
        return ( $1, $2 );
    };}
    return "Missing the H1 line";
}

sub m_info
{
    my $fh = shift;
    my $Current = undef;
    my $Info = {};

    $_ = '???';

# Parse comment lines
    while( $_ = $fh->getline() )
    {
        /^\s*$/ && do { $Current = undef; next; };

        !$Current && /^\%\s*(\(c\))\s*/ && do { 
            $Current = '(c)';
            $Info->{ $Current } = $';
            next;
        };

        ( /^\%\s*(\w+):/ || /^\%\s*(Last change):/ ) && do { 
            $Current = lc($1);
            $Info->{ $Current } = $';# =~ /^\s*$/ ? '' : $_;
            next;
        };
        /^\%/ && defined( $Current ) && do { 
   #     print "$Current += $'\n";
            $Info->{ $Current } .= $';
            next;
        };
        last;
    }

    return $Info;
}

sub HilitHelp
{
    my $fh = shift;
    my $Opts = shift;
    my $Row;

    $main::also = 0;

    while( $Row = $fh->getline() )
    {
        chomp $Row;
        $Row !~ /^\s*\%/ && last;
        $Row = $';

        print "<span class=help>";
        if( $Row =~ /^(\s*)(\w+:)\s*$/ )
        {
            $Row = $2;
            PrintOther( $1 );
            print "<span class=help_field>";
            PrintOther( $Row );
            print "</span>";
            $Row = '';
          }
          if( $Row =~ /^(\s*)See also / )
          {
              $Row = $';
              PrintOther( $1 );
              print "<span class=also_field>See also ";
              print "</span>";
              print "<span class=also>";
              $main::also = 1;
              PrintAlso( $Row, $Opts );
          }
        else
        {
            if( $main::also ) { print "<span class=also>";
                                PrintAlso( $Row, $Opts ); } 
            else { PrintOther( $Row, $Opts ); }
        }
        print "</span><br>\n";
    }
}

sub PrintAlso
{ 
    my $tx = $_[0];
    my $Opts = $_[1];
    my ($spc,$name,$sep, $h);


    while( $tx =~ /(\s*)([\w\/]+)(,|\.)?/ )
    {
        $spc = $1;
        $name = $2;

        $sep = $3;
        $tx = $';
        if( defined( $sep ) and $sep eq '.' ) { $main::also = 0; }

        $spc =~ s/ /\&nbsp;/g;
        $spc =~ s/\t/\&nbsp;\&nbsp;\&nbsp;\&nbsp;/g;
        print $spc;
        $h = $main::hash->{ lc($name) };
        if( defined( $h ) )
        {
            printf "<a href = \"" . HrefInfo( $Opts, $h->[0], $h->[1] ) .
                "\" target=\"mdsbody\">$name</a>";
        } else { print $name; }
        defined( $sep ) and print $sep;
    }
    print $tx;
}

1;



sub PrintOther
{ 
    my $tx = $_[0];
    my $Opts = $_[1];
    $tx =~ s/</\&lt;/g;
    $tx =~ s/>/\&gt;/g;

    $tx =~ s/ /\&nbsp;/g;
    $tx =~ s/\t/\&nbsp;\&nbsp;\&nbsp;\&nbsp;/g;

    my $root = $Opts->{'root'} || '';
    if( defined( $Opts->{ 'references' }[0] ) )
    {
        while( $tx =~ /($Opts->{ 'references' }[0])/ )
        { 
            my $alt = defined( $main::refpl ) ?
                "title = \"" . $main::refpl->{$1} . "\" " : '';
            {
                local ( $', $`, $1 );
                $alt =~ s/\s+/ /g;
            }
            $tx = $` . "<a href=\"$root$Opts->{'references' }[1]\#$1\" " .
                "$alt>$&<\/a>" . $';
        }
    }
    
    print $tx;
}

1;
