#!/usr/bin/perl -- # # asmdoc.pl - Skrypt generujący dokumentację podobną do Javadoc dla assemblera. # asmdoc.pl - A script which generates Javadoc-like documentation for assembler. # # Copyright (C) 2007-2021 Bogdan 'bogdro' Drozdowski # (bogdro AT users . sourceforge . net, bogdro-perl AT gmx . com) # # Licencja / License: # Powszechna Licencja Publiczna GNU v3+ / GNU General Public Licence v3+ # # Ostatnia modyfikacja / Last modified : 2021-01-12 # # Sposób użycia / Syntax: # ./asmdoc.pl aaa.asm bbb.asm ccc/ddd.asm # ./asmdoc.pl --help|-help|-h # # Wszystkie elementy linii poleceń powinny być kodowane w UTF-8, jeśli # mają znaki diakrytyczne, np. w ten sposób: # All command-line elements should be encoded in UTF-8, if they contain # national (non-ASCII) characters, e.g. like this: # # echo "Your-text-here" | iconv -f iso-8859-X -t utf-8 > tmp-file # perl asmdoc.pl -author ... -windowtitle "`cat tmp-file`" files.asm # rm -f tmp-file # (| =Shift+BackSlash; ` = lewy apostrof/left apostrophe - backtick) # # Można takie parametry oczywiście zapisać w kodzie skryptu poniżej. # Such parameters can of course be put in the code below. # # Komentarze dokumentujące powinny się zaczynać od ';;' lub '/**', a # kończyć na ';;' lub '*/'. # # Documentation comments should start with ';;' or '/**' and # end with ';;' or '*/'. # # Przyklady/Examples: # # ;; # ; Ta procedura czyta dane / This procedure reads data. # ; @param CX - liczba bajtow / number of bytes # ; @return DI - adres danych / address of data # ;; # procedure01: # ... # ret # # Niniejszy program jest wolnym oprogramowaniem; możesz go # rozprowadzać dalej i/lub modyfikować na warunkach Powszechnej # Licencji Publicznej GNU, wydanej przez Fundację Wolnego # Oprogramowania - według wersji 3-ciej tej Licencji lub którejś # z późniejszych wersji. # # Niniejszy program rozpowszechniany jest z nadzieją, iż będzie on # użyteczny - jednak BEZ JAKIEJKOLWIEK GWARANCJI, nawet domyślnej # gwarancji PRZYDATNOŚCI HANDLOWEJ albo PRZYDATNOŚCI DO OKREŚLONYCH # ZASTOSOWAŃ. W celu uzyskania bliższych informacji - Powszechna # Licencja Publiczna GNU. # # Z pewnością wraz z niniejszym programem otrzymałeś też egzemplarz # Powszechnej Licencji Publicznej GNU (GNU General Public License); # jeśli nie - napisz do Free Software Foundation: # Free Software Foundation # 51 Franklin Street, Fifth Floor # Boston, MA 02110-1301 # USA # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 3 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software Foundation: # Free Software Foundation # 51 Franklin Street, Fifth Floor # Boston, MA 02110-1301 # USA require 5.8.0; # use encoding / use utf8 use strict; use warnings; use utf8; use Cwd; use Encode; use Fcntl ':mode'; use File::Copy; use File::Spec::Functions ':ALL'; use I18N::Langinfo; use I18N::LangTags::Detect; use Getopt::Long; use PerlIO::encoding; my @languages = I18N::LangTags::implicate_supers(I18N::LangTags::Detect::detect()); my $language = ""; # language my $enc; # output character encoding my $html_ext = "html"; # rozszerzenie nazwy pliku (filename extension) ######################################################################### # Ten kod można zmieniać w celach tłumaczenia. # This code can be changed if you want to translate the program. ######################################################################### foreach (@languages) { if ( $language eq "" && /^pl/io ) { $language = "PL"; } if ( $language eq "" && /^en/io ) { $language = "EN"; } # if ( $language eq "" && /^de/io ) { $language = "DE"; } # if ( $language eq "" && /^fr/io ) { $language = "FR"; } } if ( $language eq "" ) { $language = "EN"; } # kodowanie znaków na terminalu (terminal character encoding) my %win_enc = ( "EN" => 'ascii', "PL" => 'cp1250', # "DE" => 'cp125N', # "FR" => 'cp125N', ); my %dos_enc = ( "EN" => 'ascii', "PL" => 'cp852', ); my %unix_enc = ( "CR" => 'iso-8859-2', "CZ" => 'iso-8859-2', "DA" => 'iso-8859-1', "DE" => 'iso-8859-1', "EN" => 'iso-8859-1', "ES" => 'iso-8859-1', "ET" => 'iso-8859-13', "FI" => 'iso-8859-1', "FR" => 'iso-8859-1', "GR" => 'iso-8859-7', "HU" => 'iso-8859-2', "IR" => 'iso-8859-1', "IT" => 'iso-8859-1', "LT" => 'iso-8859-13', "LV" => 'iso-8859-13', "NL" => 'iso-8859-1', "NO" => 'iso-8859-1', "PL" => 'iso-8859-2', "PT" => 'iso-8859-1', "RO" => 'iso-8859-2', "RU" => 'iso-8859-5', "SE" => 'iso-8859-1', "SK" => 'iso-8859-2', ); # ---------------- # Imagine that e.g. OpenBSD's Perl does NOT declare I18N::Langinfo::CODESET() (langinfo.h problem) my $t; eval { $t = I18N::Langinfo::CODESET(); }; #if ($@ || !defined $t) {die($@);}; if ( defined $t ) { # Linux #if ( $^O =~ /linux/i ) { ## I18N::Langinfo->import(qw(langinfo CODESET)); $enc = I18N::Langinfo::langinfo(I18N::Langinfo::CODESET()); $enc =~ tr/A-Z/a-z/; } else { # OpenBSD & maybe others if ( $^O =~ /win/io ) { $enc = $win_enc{$language} if defined($win_enc{$language}); } elsif ( $^O =~ /dos/io ) { $enc = $dos_enc{$language} if defined($dos_enc{$language}); $html_ext = "htm"; } else { $enc = $unix_enc{$language} if defined($unix_enc{$language}); } } $enc = "utf8" if $enc eq ""; $enc = lc($enc); $enc =~ s/-//go; # ---------------- my %msg_file_noread = ( "EN" => "Unable to read file.", "PL" => encode($enc, "Nie można odczytać pliku."), ); my %msg_dir_nowrite = ( "EN" => "Unable to write files to directory", "PL" => encode($enc, "Nie można zapisać plików do katalogu"), ); my %msg_help = ( "PL" => encode($enc, "AsmDoc - program generujący dokumentację HTML z podanych plików źródłowych\n". "\tjęzyka assembler. Wejdź na http://bogdro.evai.pl/inne/\n". "Autor: Bogdan 'bogdro' Drozdowski, bogdro AT users . sourceforge . net, bogdro-perl AT gmx . com.\n". "Składnia: $0 [opcje] pliki\n\n". "Opcje:\n". "-author\t\t\t\tDołącz autorów (\@author)\n". "-bottom \t\tDołącz podany tekst na dole każdej strony\n". "-charset|-docencoding \tNazwa zestawu znaków umieszczona w kodzie HTML\n\t\t\t\t\t(ostatnia wartość jest brana)\n". "-d \t\t\tUmieszcza pliki wynikowe w podanym katalogu\n". "-doctitle \t\tDołącz podany tytuł do strony głównej\n". "-encoding \t\tKodowanie znaków w plikach źródłowych\n". "-footer \t\tDołącz podaną stopkę na każdej stronie\n". "-h|--help|-help|-?\t\tWyświetla pomoc\n". "-header \t\tDołącz podany nagłówek na każdej stronie\n". "-helpfile \t\tDołącz ten plik pomocy zamiast domyślnego\n". "-ida|-idapro\t\t\tWłącz tryb IDA Pro\n". "-L|--license\t\t\tWyświetla licencję tego programu\n". "-lang <2-literowy kod>\t\tGeneruje dokumentację w języku o podanym kodzie\n\t\t\t\t\tnp. PL, EN (jeśli obsługiwany)\n". "-nocomment\t\t\tOpuść znaczniki i opisy, wygeneruj deklaracje\n". "-nodeprecated\t\t\tNie dołączaj informacji o elementach\n\t\t\t\t\tprzestarzałych (\@deprecated)\n". "-nodeprecatedlist\t\tNie twórz listy przestarzałych elementów\n". "-nohelp\t\t\t\tNie twórz pliku pomocy\n". "-noindex\t\t\tNie twórz indeksu\n". "-nonvabar\t\t\tNie dołączaj paska nawigacyjnego do plików\n". "-nosince\t\t\tNie dołączaj informacji, od której wersji dany\n\t\t\t\t\telement jest dostępny\n". "-ns|-nosort|-no-sort\t\tNie sortuj alfabetycznie procedur, struktur i danych\n". "-overview \t\tStronę główną czyta z podanego pliku\n". "-stylesheetfile \t\tPlik z arkuszem stylów\n". "-top \t\t\tDołącz podany tekst na górze każdej strony\n". "-ud|-undoc|-undocumented\tPrzetwarzaj nieudokumentowane procedury\n". "-version\t\t\tDołącz numery wersji (\@version)\n". "-windowtitle \t\tUstaw tytuł okna w przeglądarce\n". "\n\nPamiętaj, by wielowyrazowe wartości opcji umieścić w cudzysłowach!\n\n". "Komentarze dokumentujące powinny się zaczynać od ';;' lub '/**', a\n". " kończyć na ';;' lub '*/'.\n\n". "Przykład:\n\n". ";;\n". "; Ta procedura czyta dane.\n". "; \@param CX - liczba bajtów.\n". "; \@return DI - adres danych.\n". ";;\n". "procedura01:\n". "\t...\n". "\tret\n" ), "EN" => "AsmDoc - a program for generating HTML documentation from the given\n". " assembly language source files. See http://bogdro.evai.pl/inne\n". "Author: Bogdan 'bogdro' Drozdowski, bogdro AT users . sourceforge . net, bogdro-perl AT gmx . com.\n". "Syntax: $0 [options] files\n\n". "Options:\n". "-author\t\t\t\tAdd \@author information\n". "-bottom \t\tAdd the given text at the bottom of every page\n". "-charset|-docencoding \tCharset which will be put in the HTML files\n\t\t\t\t\t(last one is taken)\n". "-d \t\t\tPut resulting files in the given directory\n". "-doctitle \t\tAdd the given title to the overview page\n". "-encoding \t\tSource files' character encoding\n". "-footer \t\tAdd the given footer on every page\n". "-h|--help|-help|-?\t\tShows the help screen\n". "-header \t\tAdd the given header on every page\n". "-helpfile \t\tInculde this help file instead of a default one\n". "-ida|-idapro\t\t\tEnable IDA Pro mode\n". "-L|--license\t\t\tShows the license for this program\n". "-lang <2-letter code>\t\tGenerates the docs in the language specified\n\t\t\t\t\tby the code, eg. PL, EN (if supported)\n". "-nocomment\t\t\tSkip tags and description, generate declarations\n". "-nodeprecated\t\t\tDo not add \@deprecated elements\n". "-nodeprecatedlist\t\tDo not create a list of deprecated elements\n". "-nohelp\t\t\t\tDo not generate a help file\n". "-noindex\t\t\tDo not generate an index\n". "-nonvabar\t\t\tDo not include a navigation bar in the files\n". "-nosince\t\t\tDo not add \@since information\n". "-ns|-nosort|-no-sort\t\tDo not alphabetically sort procedures, structures and data\n". "-overview \t\tRead overview documentation from the given file\n". "-stylesheetfile \t\tStylesheet file\n". "-top \t\tAdd the given text at the top of every page\n". "-ud|-undoc|-undocumented\tProcess undocumented procedures\n". "-version\t\t\tAdd \@version information\n". "-windowtitle \t\tSet web browser window title\n". "\n\nRemember to put multi-word option values in quotation marks!\n\n". "Documentation comments should start with ';;' or '/**' and\n". " end with ';;' or '*/'.\n\n". "Example:\n\n". ";;\n". "; This procedure reads data.\n". "; \@param CX - number of bytes\n". "; \@return DI - address of data\n". ";;\n". "procedure01:\n". "\t...\n\tret\n" , ); my %msg_lic = ( "PL" => encode($enc, "AsmDoc - program generujący dokumentację HTML z podanych plików źródłowych\n". "\tjęzyka assembler. Wejdź na http://bogdro.evai.pl/inne\n". "Autor: Bogdan 'bogdro' Drozdowski, bogdro AT users . sourceforge . net, bogdro-perl AT gmx . com.\n\n". " Niniejszy program jest wolnym oprogramowaniem; możesz go\n". " rozprowadzać dalej i/lub modyfikować na warunkach Powszechnej\n". " Licencji Publicznej GNU, wydanej przez Fundację Wolnego\n". " Oprogramowania - według wersji 3-ciej tej Licencji lub którejś\n". " z późniejszych wersji.\n\n". " Niniejszy program rozpowszechniany jest z nadzieją, iż będzie on\n". " użyteczny - jednak BEZ JAKIEJKOLWIEK GWARANCJI, nawet domyślnej\n". " gwarancji PRZYDATNOŚCI HANDLOWEJ albo PRZYDATNOŚCI DO OKREŚLONYCH\n". " ZASTOSOWAŃ. W celu uzyskania bliższych informacji - Powszechna\n". " Licencja Publiczna GNU.\n\n". " Z pewnością wraz z niniejszym programem otrzymałeś też egzemplarz\n". " Powszechnej Licencji Publicznej GNU (GNU General Public License);\n". " jeśli nie - napisz do Free Software Foundation:\n". " Free Software Foundation\n". " 51 Franklin Street, Fifth Floor\n". " Boston, MA 02110-1301\n". " USA\n" ), "EN" => "AsmDoc - a program for generating HTML documentation from the given\n". " assembly language source files. See http://bogdro.evai.pl/inne\n". "Author: Bogdan 'bogdro' Drozdowski, bogdro AT users . sourceforge . net, bogdro-perl AT gmx . com.\n\n". " This program is free software; you can redistribute it and/or\n". " modify it under the terms of the GNU General Public License\n". " as published by the Free Software Foundation; either version 3\n". " of the License, or (at your option) any later version.\n\n". " This program is distributed in the hope that it will be useful,\n". " but WITHOUT ANY WARRANTY; without even the implied warranty of\n". " MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n". " GNU General Public License for more details.\n\n". " You should have received a copy of the GNU General Public License\n". " along with this program; if not, write to the Free Software Foundation:\n". " Free Software Foundation\n". " 51 Franklin Street, Fifth Floor\n". " Boston, MA 02110-1301\n". " USA\n", ); my %tag_author = ( "PL" => "Autor: ", "EN" => "Author: ", ); my %tag_depr = ( "PL" => "Przestarzałe: ", "EN" => "Deprecated: ", ); my %tag_exc = ( "PL" => "Wywołuje wyjątek: ", "EN" => "Throws: ", ); my %tag_param = ( "PL" => "Parametr: ", "EN" => "Parameter: ", ); my %tag_ret = ( "PL" => "Zwraca: ", "EN" => "Returns: ", ); my %tag_see = ( "PL" => "Zobacz też: ", "EN" => "See Also: ", ); my %tag_since = ( "PL" => "Od wersji: ", "EN" => "Since: ", ); my %tag_ver = ( "PL" => "Wersja: ", "EN" => "Version: ", ); my %title_depr = ( "PL" => "Lista elementów przestarzałych", "EN" => "Deprecated List", ); my %contents_list = ( "PL" => "Spis treści", "EN" => "Contents", ); my %depr_files = ( "PL" => "Przestarzałe pliki", "EN" => "Deprecated Files", ); my %depr_fcns = ( "PL" => "Przestarzałe funkcje", "EN" => "Deprecated Functions", ); my %depr_var = ( "PL" => "Przestarzałe zmienne", "EN" => "Deprecated Variables", ); my %depr_str = ( "PL" => "Przestarzałe struktury", "EN" => "Deprecated Structures", ); my %depr_mac = ( "PL" => "Przestarzałe makra", "EN" => "Deprecated Macros", ); my %title_constants = ( "PL" => "Wartości stałe", "EN" => "Constant values", ); my %title_over = ( "PL" => "Podsumowanie", "EN" => "Overview", ); my %fr_alert = ( "PL" => "Uwaga", "EN" => "Frame Alert", ); my %nofr = ( "PL" => "Ten dokument jest przeznaczony do oglądania z wykorzystaniem ramek. ". "Jeśli widzisz ten napis, używasz przeglądarki bez obsługi ramek.", "EN" => "This document is designed to be viewed using the frames feature. ". "If you see this message, you are using a non-frame-capable web client.", ); my %linkto = ( "PL" => "Odnośnik do", "EN" => "Link to", ); my %nonframe = ( "PL" => "wersji bez ramek", "EN" => "non-frame version", ); my %title_index = ( "PL" => "Indeks", "EN" => "Index", ); my %var_in_file = ( "PL" => "zmienna w pliku", "EN" => "variable in file", ); my %fcn_in_file = ( "PL" => "funkcja w pliku", "EN" => "function in file", ); my %str_in_file = ( "PL" => "struktura w pliku", "EN" => "structure in file", ); my %mac_in_file = ( "PL" => "makro w pliku", "EN" => "macro in file", ); my %title_help = ( "PL" => "Pomoc", "EN" => "Help", ); my %file = ( "PL" => "Plik", "EN" => "File", ); my %var_sum = ( "PL" => "Podsumowanie zmiennych", "EN" => "Variable summary" ); my %fcn_sum = ( "PL" => "Podsumowanie funkcji", "EN" => "Function summary" ); my %str_sum = ( "PL" => "Podsumowanie struktur", "EN" => "Structure summary" ); my %mac_sum = ( "PL" => "Podsumowanie makr", "EN" => "Macro summary" ); my %var_det = ( "PL" => "Szczegóły zmiennych", "EN" => "Variable detail", ); my %fcn_det = ( "PL" => "Szczegóły funkcji", "EN" => "Function detail", ); my %str_det = ( "PL" => "Szczegóły struktur", "EN" => "Structure detail", ); my %mac_det = ( "PL" => "Szczegóły makr", "EN" => "Macro detail", ); my %allfiles = ( "PL" => "Wszystkie pliki", "EN" => "All files", ); my %skipbar = ( "PL" => "Przeskocz pasek nawigacyjny", "EN" => "Skip navbar", ); my %deprec = ( "PL" => "Przestarzałe", "EN" => "Deprecated", ); my %constants = ( "PL" => "Stałe", "EN" => "Constants", ); my %prev_file = ( "PL" => "POPRZEDNI PLIK", "EN" => "PREVIOUS FILE", ); my %next_file = ( "PL" => "NASTĘPNY PLIK", "EN" => "NEXT FILE", ); my %summary = ( "PL" => "PODSUMOWANIE", "EN" => "SUMMARY", ); my %details = ( "PL" => "SZCZEGÓŁY", "EN" => "DETAILS", ); my %name_vars = ( "PL" => "ZMIENNE", "EN" => "VARIABLE", ); my %name_fcns = ( "PL" => "FUNKCJE", "EN" => "FUNCTION", ); my %name_st = ( "PL" => "STRUKTURY", "EN" => "STRUCTURE", ); my %name_mc = ( "PL" => "MAKRA", "EN" => "MACRO", ); my %name_frames = ( "PL" => "RAMKI", "EN" => "FRAMES", ); my %no_frames = ( "PL" => "BEZ RAMEK", "EN" => "NO FRAMES", ); my %helpdoc_msg = ( "PL" => "

Jak zorganizowana jest ta dokumentacja API

\n". "Ten dokument API (Application Programming Interface) zawiera strony odpowiadające ". "elementom paska nawigacyjnego, opisanych poniżej.\n". "

Plik

\n". "

Każdy plik ma swoją osobną stronę. Każda z tych stron ma trzy sekcje ". "składające się z opisu pliku, tablic z podsumowaniami oraz szczegółowych ". "opisów elementów:\n

    \n". "
  • Nazwa pliku
    • \n
  • Opis pliku


    • \n". "
  • Podsumowanie zmiennych
    • \n
  • Podsumowanie struktur
    • \n". "
  • Podsumowanie makr
    • \n
  • Podsumowanie funkcji


    • \n". "
  • Szczegóły zmiennych
    • \n
  • Szczegóły struktur
    • \n". "
  • Szczegóły makr
    • \n
  • Szczegóły funkcji
    • \n
\n". "Każdy wpis podsumowania zawiera pierwsze zdanie z opisu szczegółowego ". "danego elementu. Wpisy w podsumowaniu są alfabetyczne, podobnie jak w opisach ". "szczegółowych.
\n". "

Lista elementów przestarzałych

\n". "Strona Lista elementów przestarzałych zawiera wszystkie ". "elementy przestarzałe. Nie są one zalecane do użycia, ". "zazwyczaj w wyniku ulepszeń. Zwykle podawany jest element zastępczy. ". "Elementy przestarzałe mogą zostać usunięte w przyszłych implementacjach.
\n". "

Indeks

\n". "Indeks zawiera alfabetyczną listę wszystkich ". "plików, funkcji i zmiennych.
\n". "

POPRZEDNI PLIK / NASTĘPNY PLIK

\n". "Te odnośniki przenoszą do poprzedniego lub następnego pliku.\n". "

RAMKI / BEZ RAMEK

\n". "Te odnośniki pokazują i chowają ramki HTML. Wszystkie strony są dostępne z ramkami lub bez.\n". "

Wartości stałe

\n". "Strona Wartości stałe zawiera stałe ". "oraz ich wartości.\n", "EN" => "

How This API Document Is Organized

\n". "This API (Application Programming Interface) document has pages corresponding ". "to the items in the navigation bar, described as follows.\n". "

File

\n". "

Each file has its own separate page. Each of these pages has three ". "sections consisting of a file description, summary tables, and detailed ". "member descriptions:\n

    \n". "
  • File name
    • \n
  • File description


    • \n". "
  • Variable summary
    • \n
  • Structure summary
    • \n". "
  • Macro summary
    • \n
  • Function summary


    • \n". "
  • Variable details
    • \n
  • Structure details
    • \n". "
  • Macro details
    • \n
  • Function details
    • \n
\n". "Each summary entry contains the first sentence from the detailed description ". "for that item. The summary entries are alphabetical, as in the detailed ". "descriptions.
\n". "

Deprecated List

\n". "The Deprecated List page lists all of the ". "API that have been deprecated. A deprecated API is not recommended for use, ". "generally due to improvements, and a replacement API is usually given. ". "Deprecated APIs may be removed in future implementations.
\n". "

Index

\n". "The Index contains an alphabetic list of all ". "files, functions, and variables.
\n". "

PREVIOUS FILE / NEXT FILE

\n". "These links take you to the next or previous file.\n". "

FRAMES / NO FRAMES

\n". "These links show and hide the HTML frames. All pages are available with or without frames.\n". "

Constant values

\n". "The Constant values page lists the ". "constants and their values.\n", ); ########################################################################## # Koniec rzeczy do tłumaczenia (end of translation stuff) ########################################################################## #use encoding "utf8", STDOUT => $enc; if ( @ARGV == 0 ) { print_help(); exit 1; } Getopt::Long::Configure("ignore_case", "ignore_case_always"); my $help=''; my $overview=''; my $encoding='iso-8859-1'; my $d=curdir(); my $version=''; my $author=''; my $windowtitle='AsmDoc-generated Documentation (no title)'; my $doctitle=''; my $header=''; my $footer=''; my $top=''; my $bottom=''; my $nocomment=''; my $nodeprecated=''; my $nosince=''; my $nodeprecatedlist=''; my $noindex=''; my $charset='utf-8'; my $stylesheetfile=''; my $lic=''; my $nohelp=''; my $helpfile=''; my $nonavbar=''; my $undoc=''; my $nosort=''; my $idapro=''; if ( !GetOptions ( 'author' => \$author, 'bottom=s' => \$bottom, 'charset|docencoding=s' => \$charset, 'd=s' => \$d, 'doctitle=s' => \$doctitle, 'encoding=s' => \$encoding, 'footer=s' => \$footer, 'h|help|?' => \$help, 'header=s' => \$header, 'helpfile=s' => \$helpfile, 'ida|idapro' => \$idapro, 'license|licence|l' => \$lic, 'lang=s' => \$language, 'nocomment' => \$nocomment, 'nodeprecated' => \$nodeprecated, 'nodeprecatedlist' => \$nodeprecatedlist, 'nohelp' => \$nohelp, 'noindex' => \$noindex, 'nonavbar' => \$nonavbar, 'nosince' => \$nosince, 'no-sort|nosort|ns' => \$nosort, 'overview=s' => \$overview, 'stylesheetfile=s' => \$stylesheetfile, 'top=s' => \$top, 'undocumented|undoc|ud' => \$undoc, 'version' => \$version, 'windowtitle=s' => \$windowtitle, ) ) { print_help(); exit 2; } $language =~ tr/a-z/A-Z/; if ( $lic ) { print $msg_lic{$language}; exit 1; } # jesli podano "HELP" na linii polecen lub nie podano plikow, wyswietlic skladnie wywolania # (if "HELP" is on the command line or no files are given, print syntax) if ( $help || @ARGV == 0 ) { print_help(); exit 1; } # sprawdzic, czy wszystkie podane pliki sa odczytywalne, a katalogi zapisywalne. # (check if all the given files are readable and directories writeable) if ( $stylesheetfile ne "" && (-d $stylesheetfile || ! -r $stylesheetfile) ) { print "$0: $stylesheetfile: $msg_file_noread{$language}\n"; exit 3; } if ( $overview ne "" && (-d $overview || ! -r $overview) ) { print "$0: $overview: $msg_file_noread{$language}\n"; exit 3; } if ( $helpfile ne "" && (-d $helpfile || ! -r $helpfile) ) { print "$0: $helpfile: $msg_file_noread{$language}\n"; exit 3; } # tworzenie katalogu, jesli potrzeba (creating the directory if necessary) if ( ! -e $d ) { my @dirs = splitdir $d; my $i = 0; foreach (@dirs) { if ( ! -e $_ ) { mkdir $_ or die "$0: mkdir $d ('$_'): $!"; chmod S_IRWXU, $_; } chdir $_ or die "$0: chdir $d ('$_'): $!"; $i++; } for ( ; $i>0; $i-- ) { chdir updir(); } } if ( ! -w $d ) { print "$0: $msg_dir_nowrite{$language} '$d'.\n"; exit 3; } # kopiowanie arkusza stylów (copy the style sheet) if ( $stylesheetfile ne "" && $d ne curdir() ) { my ($vol, $dir, $f); ($vol, $dir, $f) = splitpath $stylesheetfile; copy($stylesheetfile, catpath($vol, rel2abs($d, rootdir()), $f)); $stylesheetfile = $f; } # kopiowanie pliku podsumowania (copy the overview file) if ( $overview ne "" && $d ne curdir() ) { my ($vol, $dir, $f); ($vol, $dir, $f) = splitpath $overview; copy($overview, catpath($vol, rel2abs($d, rootdir()), $f)); $overview = $f; } # kopiowanie pliku pomocy (copy the help file) if ( $helpfile ne "" && $d ne curdir() ) { my ($vol, $dir, $f); ($vol, $dir, $f) = splitpath $helpfile; copy($helpfile, catpath($vol, rel2abs($d, rootdir()), $f)); $helpfile = $f; } my ($disc, $directory, undef) = splitpath(cwd(), 1); chdir $d; my $docroot = cwd(); my @files = sort @ARGV; my %files_orig; foreach my $p (@files) { my $newf; ($newf = $p) =~ s/\./-/go; $newf = (splitpath $newf)[2]; $newf = encode($charset, $newf); $files_orig{$newf} = (splitpath $p)[2]; # =$p; } $charset =~ tr/A-Z/a-z/; # Tagi mogą się zaczynać od '@' (Java) lub '\' (C/C++). # Tags can start with '@' (Java) or '\' (C/C++). # http://java.sun.com/j2se/1.5.0/docs/tooldocs/windows/javadoc.html#javadoctags my %tags_subst = ( "author" => $tag_author{$language}, "deprecated" => $tag_depr{$language}, "exception" => $tag_exc{$language}, "param" => $tag_param{$language}, "return" => $tag_ret{$language}, "see" => $tag_see{$language}, "since" => $tag_since{$language}, "throws" => $tag_exc{$language}, "version" => $tag_ver{$language}, ); # The first hashes go like this: # file_description, file_variables, file_functions, file_variables_description, # file_function_description, file_variable_values, file_structures, file_structrues_description, # file_structure_variables, file_structure_variables_description, file_structure_variables_values # file_macros, file_macros_description my (%files_descr, %files_vars, %files_funcs, %files_vars_descr, %files_funcs_descr, %files_vars_values, %files_struct, %files_struct_descr, %files_struct_vars, %files_struct_vars_descr, %files_struct_vars_values, %files_macros, %files_macros_descr, %files_funcs_vars, %files_funcs_vars_descr, %files_funcs_vars_values, %files_funcs_vars_types); # =================== Czytanie plikow wejsciowych (reading input files) ================= FILES: foreach my $p (@files) { # Klucz w tablicy haszowanej to nazwa pliku z myślnikami zamiast kropek. # Hash array key is the filename with dashes instead of dots. my $key; $key = (splitpath $p)[2]; $key =~ s/\./-/go; # Aktualna zmienna (lub funkcja) i jej opis. # Current variable (or function) and its description. # (current_variable, current_variable_description, current_variable_value, function, # type, structure, inside_struc, structure name, macro) my ($current_variable, $current_variable_descr, $current_variable_value, $function, $type, $structure, $inside_struc, $struc_name, $macro, $inside_func, $func_name, $have_descr, $current_type); $type = 0; $function = 0; $structure = 0; $inside_struc = 0; $macro = 0; $struc_name = ""; $inside_func = 0; $func_name = ""; $files_vars{$key} = (); $files_funcs{$key} = (); $files_struct{$key} = (); $files_macros{$key} = (); open(my $asm, "<:encoding($encoding)", catpath($disc, $directory, $p)) or die "$0: ".catpath($disc, $directory, $p).": $!\n"; $have_descr = 0; # znaleźć opis pliku, jeśli jest. (find file description, if it exists) MAIN_DESCR: while ( <$asm> ) { next if (/^\s*$/o && ! $idapro); # to leave when an empty line is encountered (IDA Pro) if (($undoc) && ($have_descr == 0)) { $type = 1 if ( /^\s*;;/o && $type == 0 ); $type = 2 if ( /^\s*\/\*\*/o && $type == 0 ); $files_descr{$key} .= "" if ($type == 0); $type = 1 if ($type == 0); } $type = 1 if ( /^\s*;;/o && $type == 0 ); $type = 2 if ( /^\s*\/\*\*/o && $type == 0 ); if ( $type == 1 ) { last MAIN_DESCR if ( $undoc && (! /^\s*;/o) && $have_descr ); last MAIN_DESCR if ( ((! /^\s*;/o) || /^\s*;;\s*$/o) && $have_descr ); } elsif ( $type == 2 ) { last MAIN_DESCR if /^\s*\*\/\s*$/o; } # odrzucamy wiodące znaki komentarza na początku linii # (removing leading comment characters from the beginning of the line) s/^\s*;+//o if $type == 1; s/^\s*\/?\*+//o if $type == 2; $files_descr{$key} .= $_ if $type != 0; $have_descr = 1; } if ( ! defined $_ ) { close $asm; next FILES; } if ( /^\s*;;\s*$/o || /^\s*\*\/\s*$/o ) { $_ = <$asm>; if ( ! defined $_ ) { close $asm; next FILES; } } $files_descr{$key} = tags($files_descr{$key}); # Jesli pierwszy komentarz nie dotyczył pliku (if the first comment wasn't about the file) if ( ! /^\s*$/o ) { # zmienna lub stała typu 1 (variable/type 1 constant) (xxx equ yyy) if ( /^\s*([\.\w]+)(:|\s+)\s*(times\s|(d|r|res)[bwudpfqt]\s|equ\s|=)+\s*([\w\,\.\+\-\s\*\/\\\'\"\!\@\#\$\%\^\&\\(\)\{\}\[\]\<\>\?\=\|]*)/io ) { $files_vars{$key}[++$#{$files_vars{$key}}] = $1; $files_vars_descr{$key}{$1} = $files_descr{$key}; $function = 0; my $value = $5; if ( $3 =~ /equ/io || $3 =~ /=/o ) { $files_vars_values{$key}{$1} = $value; } else { $files_vars_values{$key}{$1} = ""; } undef($files_descr{$key}); } # stala typu 2 (type 2 constant) (.equ xxx yyy) elsif ( /^\s*\.equ?\s*(\w+)\s*,\s*([\w\,\.\+\-\s\*\/\\\'\"\!\@\#\$\%\^\&\\(\)\{\}\[\]\<\>\?\=\|]*)/io ) { $files_vars{$key}[++$#{$files_vars{$key}}] = $1; $files_vars_descr{$key}{$1} = $files_descr{$key}; $files_vars_values{$key}{$1} = $2; undef($files_descr{$key}); } # początek tradycyjnej procedury (traditional procedure beginning) elsif ( /^\s*(\w+)(\s*:|\s+(proc|near|far){1,2})\s*($|;.*$)/io ) { $files_funcs{$key}[++$#{$files_funcs{$key}}] = $1; $files_funcs_descr{$key}{$1} = $files_descr{$key}; $func_name = $1; # enabling this makes the script fail on procedures that don't have # an explicit end, because once such a procedure is encountered, # everything from that point is taken as a part of the procedure, because # $inside_func is reset to zero only when /endp/ was found #$inside_func = 1; undef($files_descr{$key}); } # procedura w składni HLA (HLA syntax procedure) elsif ( /^\s*proc(edure)?\s*(\w+)/io ) { $files_funcs{$key}[++$#{$files_funcs{$key}}] = $2; $files_funcs_descr{$key}{$2} = $files_descr{$key}; $func_name = $2; $inside_func = 1; undef($files_descr{$key}); } # struktury (structures) elsif ( /^\s*struc\s+(\w+)/io ) { $files_struct{$key}[++$#{$files_struct{$key}}] = $1; $files_struct_descr{$key}{$1} = $files_descr{$key}; $structure = 1; $inside_struc = 1; $struc_name = $1; undef($files_descr{$key}); } # makra (macros) elsif ( /^\s*((\%i?)?|\.)macro\s+(\w+)/io ) { $files_macros{$key}[++$#{$files_macros{$key}}] = $3; $files_macros_descr{$key}{$3} = $files_descr{$key}; undef($files_descr{$key}); } elsif ( /^\s*(\w+)\s+macro/io ) { $files_macros{$key}[++$#{$files_macros{$key}}] = $1; $files_macros_descr{$key}{$1} = $files_descr{$key}; undef($files_descr{$key}); } # structure instances in NASM elsif ( /^\s*(\w+):?\s+istruc\s+(\w+)/io ) { $files_vars{$key}[++$#{$files_vars{$key}}] = $1; $files_vars_descr{$key}{$1} = $files_descr{$key}; undef($files_descr{$key}); } # dup() elsif ( /^\s*(\w+)\:?\s+(d([bwudpfqt])\s+\w+\s*\(?\s*\bdup\b.*)/io ) { $files_vars{$key}[++$#{$files_vars{$key}}] = $1; $files_vars_descr{$key}{$1} = $files_descr{$key}; undef($files_descr{$key}); } # MASM PROC elsif ( /^\s*(\w+):?\s+(proc)/io ) { $files_funcs{$key}[++$#{$files_funcs{$key}}] = $1; $files_funcs_descr{$key}{$1} = $files_descr{$key}; $inside_func = 1; $func_name = $1; $function = 2; undef($files_descr{$key}); } # MASM STRUCTURE elsif ( /^\s*(\w+):?\s+(struc)/io ) { $files_struct{$key}[++$#{$files_struct{$key}}] = $1; $files_struct_descr{$key}{$1} = $files_descr{$key}; $structure = 1; $inside_struc = 1; $struc_name = $1; undef($files_descr{$key}); } # some other type (like FASM structure instances) elsif ( /^\s*(\w+):?\s+(\w+)/io ) { $files_vars{$key}[++$#{$files_vars{$key}}] = $1; $files_vars_descr{$key}{$1} = $files_descr{$key}; undef($files_descr{$key}); } } while ( <$asm> ) { undef ($current_variable); undef ($current_variable_descr); undef ($current_variable_value); # IDA-Pro Subroutine comment substitution (MASM PROC) if ($undoc && ( /^;.*(S\s+U\s+B)/oi )) { $_ = ";; "; } # MASM Proc End if ( $inside_func && /^\s*(\w+):?\s+(endp)/io ) { $inside_func = 0; $function = 0; } if ( $inside_func && $idapro ) { $current_type = ""; if ( /;/o ) { $current_variable_descr = $_; $current_variable_descr =~ s/.*;//o; } else { $current_variable_descr = ""; } # type 3 constant (var_15 = byte ptr -15h, arg_0 = word ptr 2) if ( /^\s*((arg|var)\w+)\s+\=\s+?([\w\s\-\+]+)[;]?/io ) { # IDA-Pro when inside function arguments and variables. $current_variable = $1; $current_variable_value = $3; $current_type = $2; } if ($current_type ne "") { $files_funcs_vars{$key}{$func_name}[++$#{$files_funcs_vars{$key}{$func_name}}] = $current_variable; $files_funcs_vars_values{$key}{$func_name}{$current_variable} = $current_variable_value; $files_funcs_vars_descr{$key}{$func_name}{$current_variable} = $current_variable_descr; $current_variable =~ s/^\.//o; $files_funcs_vars_types{$key}{$func_name}{$current_variable} = $current_type; undef ($current_variable_descr); } } if ( $inside_struc && ( /^\s*(endstruc|\})/io || /^\s*(\w+):?\s+(ends)/io ) ) { $structure = 0; $inside_struc = 0; } # MASM PROC (undoc) if ( $undoc && /^\s*(\w+):?\s+(proc)/io ) { $files_funcs{$key}[++$#{$files_funcs{$key}}] = $1; #$files_descr{$key} = ""; #$files_funcs_descr{$key}{$1} = $files_descr{$key}; $function = 2; $inside_func = 1; $func_name = $1; } # szukać znakow zaczynających komentarz (look for characters which start a comment) next if ! ( /^\s*;;/o || /^\s*\/\*\*/o ); $type = 1 if /^\s*;;/o; $type = 2 if /^\s*\/\*\*/o; $current_variable_descr = $_; $current_variable_descr =~ s/^\s*;+//o if $type == 1; $current_variable_descr =~ s/^\s*\/?\*+//o if $type == 2; $have_descr = 0; # Wszystko do pierwszej niezakomentowanej linii skopiować do aktualnego opisu. # (Put all up to the first non-comment line into the current description). while ( <$asm> ) { next if /^\s*$/o; # to leave when an empty line is encountered (IDA Pro) if (/^\s*$/o && ! $idapro) {$_ = ";;\n"; last;} if ( $type == 1 ) { last if ( (! /^\s*;/o) || /^\s*;;\s*$/o && $have_descr ); } elsif ( $type == 2 ) { last if /^\s*\*\/\s*$/o; } # odrzucamy wiodące znaki komentarza na początku linii # (removing leading comment characters from the beginning of the line) s/^\s*;+//o if $type == 1; s/^\s*\/?\*+//o if $type == 2; $current_variable_descr .= $_ if $type != 0; $have_descr = 1; } if ( ! defined $_ ) { close $asm; next FILES; } if ( $inside_func && $idapro ) { $current_type = ""; if ( /;/o ) { $current_variable_descr = $_; $current_variable_descr =~ s/.*;//o; } else { $current_variable_descr = ""; } # type 3 constant (var_15 = byte ptr -15h, arg_0 = word ptr 2) if ( /^\s*((arg|var)\w+)\s+\=\s+?([\w\s\-\+]+)[;]?/io ) { # IDA-Pro when inside function arguments and variables. $current_variable = $1; $current_variable_value = $3; $current_type = $2; } if ($current_type ne "") { $files_funcs_vars{$key}{$func_name}[++$#{$files_funcs_vars{$key}{$func_name}}] = $current_variable; $files_funcs_vars_values{$key}{$func_name}{$current_variable} = $current_variable_value; $files_funcs_vars_descr{$key}{$func_name}{$current_variable} = $current_variable_descr; $current_variable =~ s/^\.//o; $files_funcs_vars_types{$key}{$func_name}{$current_variable} = $current_type; undef ($current_variable_descr); } } if ( /^\s*;;\s*$/o || /^\s*\*\/\s*$/o ) { $_ = <$asm>; if ( ! defined $_ ) { close $asm; next FILES; } } while ( /^\s*$/o ) { $_ = <$asm>; if ( ! defined $_ ) { close $asm; next FILES; } } # znajdowanie nazwy zmiennej lub funkcji (finding the name of the variable or function) # zmienna lub stała typu 1 (variable/type 1 constant) (xxx equ yyy) if ( /^\s*([\.\w]+)(:|\s+)\s*(times\s|(d|r|res)[bwudpfqt]\s|equ\s|=)+\s*([\w\,\.\+\-\s\*\/\\\'\"\!\@\#\$\%\^\&\\(\)\{\}\[\]\<\>\?\=\|]*)/io ) { $current_variable = $1; $function = 0; my $value = $5; if ( $3 =~ /equ/io || $3 =~ /=/o ) { $current_variable_value = $value; } else { $current_variable_value = ""; } } # stała typu 2 (type 2 constant) (.equ xxx yyy) elsif ( /^\s*\.equ?\s*(\w+)\s*,\s*([\w\,\.\+\-\s\*\/\\\'\"\!\@\#\$\%\^\&\\(\)\{\}\[\]\<\>\?\=\|]*)/io ) { $current_variable = $1; $function = 0; $current_variable_value = $2; } # początek tradycyjnej procedury (traditional procedure beginning) elsif ( /^\s*(\w+)(:|\s*(proc|near|far){1,2})\s*($|;.*$)/io ) { $current_variable = $1; $function = 1; $current_variable_value = ""; $func_name = $1; # enabling this makes the script fail on procedures that don't have # an explicit end, because once such a procedure is encountered, # everything from that point is taken as a part of the procedure, because # $inside_func is reset to zero only when /endp/ was found #$inside_func = 1; } # procedura w składni HLA (HLA syntax procedure) elsif ( /^\s*proc(edure)?\s*(\w+)/io ) { $current_variable = $2; $function = 1; $current_variable_value = ""; $func_name = $2; $inside_func = 1; } # struktury (structures) elsif ( /^\s*struc\s+(\w+)/io ) { $struc_name = $1; $function = 0; $structure = 1; $inside_struc = 0; } # makra (macros) elsif ( /^\s*((\%i?)?|\.)macro\s+(\w+)/io ) { $current_variable = $3; $macro = 1; $current_variable_value = ""; } elsif ( /^\s*(\w+)\s+macro/io ) { $current_variable = $1; $macro = 1; $current_variable_value = ""; } # structure instances in NASM elsif ( /^\s*(\w+):?\s+istruc\s+(\w+)/io ) { $current_variable = $1; $current_variable_value = ""; } # dup() elsif ( /^\s*(\w+)\:?\s+(d([bwudpfqt])\s+\w+\s*\(?\s*\bdup\b.*)/io ) { $current_variable = $1; $current_variable_value = ""; } # MASM PROC elsif ( /^\s*(\w+):?\s+(proc)/io ) { $function = 2; $current_variable_value = ""; $inside_func = 1; } # MASM STRUCTURE elsif ( /^\s*(\w+):?\s+(struc)/io ) { $struc_name = $1; $structure = 1; $inside_struc = 0; $current_variable_value = ""; } # some other type (like FASM structure instances) elsif ( /^\s*(\w+):?\s+(\w+)/io ) { $current_variable = $1; $current_variable_value = ""; } else { while ( /^\s*$/o ) { $_ = <$asm>; if ( ! defined $_ ) { close $asm; next FILES; } } if ( /^\s*$/o && $idapro ) { $current_variable = " "; $current_variable_value = ""; } elsif ( (! /^\s*end\s*$/io) || (! $idapro) ) { s/[\r\n]*$//o; print encode($enc, "$0: $p: '$_' ???\n"); } next; } if ( defined ($current_variable_descr) ) { $current_variable_descr = tags($current_variable_descr); } if ( defined ($current_variable_value) ) { # {@value} $current_variable_descr =~ s/\{\s*(\@|\\)value\s*\}/$current_variable_value/ig; } if ( $function ) { $files_funcs{$key}[++$#{$files_funcs{$key}}] = $current_variable; $files_funcs_descr{$key}{$current_variable} = $current_variable_descr; if ( $function == 2 ) { $files_funcs_vars{$key}{$func_name} = (); $files_funcs_vars_descr{$key}{$func_name} = (); $files_funcs_vars_values{$key}{$func_name} = (); $inside_func = 1; $function = 0; } } elsif ( $structure ) { $files_struct{$key}[++$#{$files_struct{$key}}] = $struc_name; $files_struct_descr{$key}{$struc_name} = $current_variable_descr; $files_struct_vars{$key}{$struc_name} = (); $files_struct_vars_descr{$key}{$struc_name} = (); $files_struct_vars_values{$key}{$struc_name} = (); $inside_struc = 1; $structure = 0; } elsif ( $macro ) { $files_macros{$key}[++$#{$files_macros{$key}}] = $current_variable; $files_macros_descr{$key}{$current_variable} = $current_variable_descr; $macro = 0; } else { if ( $inside_struc ) { $files_struct_vars{$key}{$struc_name}[++$#{$files_struct_vars{$key}{$struc_name}}] = $current_variable; $files_struct_vars_descr{$key}{$struc_name}{$current_variable} = $current_variable_descr; $files_struct_vars_values{$key}{$struc_name}{$current_variable} = $current_variable_value; } elsif ( $inside_func ) { $files_funcs_vars{$key}{$func_name}[++$#{$files_funcs_vars{$key}{$func_name}}] = $current_variable; $files_funcs_vars_descr{$key}{$func_name}{$current_variable} = $current_variable_descr; $files_funcs_vars_values{$key}{$func_name}{$current_variable} = $current_variable_value; $current_variable =~ s/^\.//o; $files_funcs_vars_types{$key}{$func_name}{$current_variable} = $current_type; } else { $files_vars{$key}[++$#{$files_vars{$key}}] = $current_variable; $files_vars_descr{$key}{$current_variable} = $current_variable_descr; $files_vars_values{$key}{$current_variable} = $current_variable_value; } } } close $asm; # Sort names if ( ! $nosort ) { if ( $#{$files_vars{$key}} >= 0 ) { my @sorted = sort @{$files_vars{$key}}; $files_vars{$key} = (); foreach (@sorted) { push @{$files_vars{$key}}, $_; } } if ( $#{$files_funcs{$key}} >= 0 ) { my @sorted = sort @{$files_funcs{$key}}; $files_funcs{$key} = (); foreach (@sorted) { push @{$files_funcs{$key}}, $_; } } if ( $#{$files_struct{$key}} >= 0 ) { my @sorted = sort @{$files_struct{$key}}; $files_struct{$key} = (); foreach (@sorted) { push @{$files_struct{$key}}, $_; } } if ( $#{$files_macros{$key}} >= 0 ) { my @sorted = sort @{$files_macros{$key}}; $files_macros{$key} = (); foreach (@sorted) { push @{$files_macros{$key}}, $_; } } } } # zamiana tagu {@value} (changing the {@value} tag) foreach my $k (keys %files_descr) { if ( $files_descr{$k} =~ /\{(\@|\\)value\s+([\w\.\#]+\s*)?(\w+)\s*\}/io ) { my $variable = $2; if ( defined($files_vars_values{$k}{$variable}) ) { s/\{(\@|\\)value\s+([\w\.\#]+\s*)?(\w+)\s*\}/$files_vars_values{$k}{$variable}/gi; } } } foreach my $k (keys %files_vars_descr) { foreach ($files_vars_descr{$k}) { if ( /\{(\@|\\)value\s+([\w\.\#]+\s*)?(\w+)\s*\}/io ) { my $variable = $2; if ( defined($files_vars_values{$k}{$variable}) ) { s/\{(\@|\\)value\s+([\w\.\#]+\s*)?(\w+)\s*\}/$files_vars_values{$k}{$variable}/gi; } } } } foreach my $k (keys %files_funcs_descr) { foreach ($files_funcs_descr{$k}) { if ( /\{(\@|\\)value\s+([\w\.\#]+\s*)?(\w+)\s*\}/io ) { my $variable = $2; if ( defined($files_vars_values{$k}{$variable}) ) { s/\{(\@|\\)value\s+([\w\.\#]+\s*)?(\w+)\s*\}/$files_vars_values{$k}{$variable}/gi; } } } } foreach my $k (keys %files_struct_descr) { foreach ($files_struct_descr{$k}) { if ( /\{(\@|\\)value\s+([\w\.\#]+\s*)?(\w+)\s*\}/io ) { my $variable = $2; if ( defined($files_vars_values{$k}{$variable}) ) { s/\{(\@|\\)value\s+([\w\.\#]+\s*)?(\w+)\s*\}/$files_vars_values{$k}{$variable}/gi; } } } } foreach my $k (keys %files_macros_descr) { foreach ($files_macros_descr{$k}) { if ( /\{(\@|\\)value\s+([\w\.\#]+\s*)?(\w+)\s*\}/io ) { my $variable = $2; if ( defined($files_vars_values{$k}{$variable}) ) { s/\{(\@|\\)value\s+([\w\.\#]+\s*)?(\w+)\s*\}/$files_vars_values{$k}{$variable}/gi; } } } } # zmiana kropek w nazwach na myślniki, by nie tworzyć nazw z wieloma kropkami # (changing dots to dashes in file names, so there won't be names with multiple dots) foreach (@files) { s/\./-/go; } # ============================ deprecated-list.html =================================== my $have_const = 0; # sprawdzamy, czy będą jakieś stałe (dla paska nawigacyjnego) # (check if there will be any constants [for the navigation bar]) ST: foreach my $p (@files) { $p = (splitpath $p)[2]; # najpierw sprawdzić, czy w danym pliku były jakiekolwiek stałe # (first check if there were any constants in the file) foreach (%{$files_vars_values{$p}}) { if ( defined($files_vars_values{$p}{$_}) && $files_vars_values{$p}{$_} ne "" ) { $have_const = 1; last ST; } } } if ( $have_const ) { open(my $xxx, ">constant-values.$html_ext"); close $xxx; } # touch constant-values.html; # generować plik tylko, gdy potrzebny (generate the file only if necessary) my ($depr_files, $depr_funcs, $depr_vars, $depr_str, $depr_ma); $depr_files = 0; foreach (keys %files_descr) { if ( $files_descr{$_} =~ /(\@|\\)deprecated/io ) { $depr_files = 1; last; } } $depr_vars = 0; ZM: foreach my $k (keys %files_vars_descr) { foreach ( %{$files_vars_descr{$k}} ) { if ( defined($files_vars_descr{$k}{$_}) && $files_vars_descr{$k}{$_} =~ /(\@|\\)deprecated/io ) { $depr_vars = 1; last ZM; } } } $depr_funcs = 0; FC: foreach my $k (keys %files_funcs_descr) { foreach ( %{$files_funcs_descr{$k}} ) { if ( defined($files_funcs_descr{$k}{$_}) && $files_funcs_descr{$k}{$_} =~ /(\@|\\)deprecated/io ) { $depr_funcs = 1; last FC; } } } $depr_str = 0; ST: foreach my $k (keys %files_struct_descr) { foreach ( %{$files_struct_descr{$k}} ) { if ( defined($files_struct_descr{$k}{$_}) && $files_struct_descr{$k}{$_} =~ /(\@|\\)deprecated/io ) { $depr_str = 1; last ST; } } } $depr_ma = 0; MA: foreach my $k (keys %files_macros_descr) { foreach ( %{$files_macros_descr{$k}} ) { if ( defined($files_macros_descr{$k}{$_}) && $files_macros_descr{$k}{$_} =~ /(\@|\\)deprecated/io ) { $depr_ma = 1; last MA; } } } if ( ! $nodeprecatedlist && ( $depr_files || $depr_vars || $depr_funcs || $depr_str || $depr_ma ) ) { open(my $deprec, ">:encoding($charset)", "deprecated-list.$html_ext") or die "$0: deprecated-list.$html_ext: $!\n"; print $deprec "\n". "\n". "\n". "\n". "\n". "\n". "$windowtitle - $title_depr{$language}\n"; if ( $stylesheetfile eq "" ) { print $deprec "\n"; } else { print $deprec "\n"; } print $deprec "\n".$top."
".nav_bar(1, "deprecated-list.$html_ext")."\n". "

$title_depr{$language}

\n
\n". "$contents_list{$language}\n\n"; my $descr; if ( $depr_files ) { print $deprec "\n". "". "\n". "\n"; foreach (@files) { $_ = (splitpath $_)[2]; if ( defined($files_descr{$_}) && $files_descr{$_} =~ /(\@|\\)deprecated/io ) { # Bierzemy tylko informację o przedawnieniu # (take only the deprecation information) ($descr = $files_descr{$_}) =~ s/.*(\@|\\)deprecated\s+(.*)(\@\w|\\\w|$)/$2/i; print $deprec "\n". "\n"; } } print $deprec "
$depr_files{$language}
$files_orig{$_}\n
\n". "$descr
\n"; } if ( $depr_funcs ) { print $deprec "\n". "". "\n". "\n"; foreach my $p (@files) { $p = (splitpath $p)[2]; if ( defined($files_funcs_descr{$p}) ) { foreach (%{$files_funcs_descr{$p}}) { next if ( ! defined($files_funcs_descr{$p}{$_}) || $files_funcs_descr{$p}{$_} !~ /(\@|\\)deprecated/io ); # Bierzemy tylko informację o przedawnieniu # (take only the deprecation information) $descr = $files_funcs_descr{$p}{$_}; $descr =~ s/^[^\@\\]*//o; while ( $descr !~ /^[\@\\]deprecated/io ) { $descr =~ s/^[\@\\][^\@\\]+//o; } $descr =~ /(\@|\\)deprecated\s+([^\@\\]*)(\@\w.*|\\\w.*|$)/io; $descr = $2; my $no_under; ($no_under = $_) =~ s/^_+//o; print $deprec "\n". "\n"; } } } print $deprec "
$depr_fcns{$language}
$files_orig{$p} -- $_\n
\n". "$descr
\n"; } if ( $depr_vars ) { print $deprec "\n". "". "\n". "\n"; foreach my $p (@files) { $p = (splitpath $p)[2]; if ( defined($files_vars_descr{$p}) ) { foreach (%{$files_vars_descr{$p}}) { next if ( ! defined($files_vars_descr{$p}{$_}) || $files_vars_descr{$p}{$_} !~ /(\@|\\)deprecated/io ); # Bierzemy tylko informację o przedawnieniu # (take only the deprecation information) $descr = $files_vars_descr{$p}{$_}; $descr =~ s/^[^\@\\]*//o; while ( $descr !~ /^[\@\\]deprecated/io ) { $descr =~ s/^[\@\\][^\@\\]+//o; } $descr =~ /(\@|\\)deprecated\s+([^\@\\]*)(\@\w.*|\\\w.*|$)/io; $descr = $2; my $no_under; ($no_under = $_) =~ s/^_+//o; print $deprec "\n". "\n"; } } } print $deprec "
$depr_var{$language}
$files_orig{$p} -- $_\n
\n". "$descr
\n"; } if ( $depr_str ) { print $deprec "\n". "". "\n". "\n"; foreach my $p (@files) { $p = (splitpath $p)[2]; if ( defined($files_struct_descr{$p}) ) { foreach (%{$files_struct_descr{$p}}) { next if ( ! defined($files_struct_descr{$p}{$_}) || $files_struct_descr{$p}{$_} !~ /(\@|\\)deprecated/io ); # Bierzemy tylko informację o przedawnieniu # (take only the deprecation information) $descr = $files_struct_descr{$p}{$_}; $descr =~ s/^[^\@\\]*//o; while ( $descr !~ /^[\@\\]deprecated/io ) { $descr =~ s/^[\@\\][^\@\\]+//o; } $descr =~ /(\@|\\)deprecated\s+([^\@\\]*)(\@\w.*|\\\w.*|$)/io; $descr = $2; my $no_under; ($no_under = $_) =~ s/^_+//o; print $deprec "\n". "\n"; } } } print $deprec "
$depr_str{$language}
$files_orig{$p} -- $_\n
\n". "$descr
\n"; } if ( $depr_ma ) { print $deprec "\n". "". "\n". "\n"; foreach my $p (@files) { $p = (splitpath $p)[2]; if ( defined($files_macros_descr{$p}) ) { foreach (%{$files_macros_descr{$p}}) { next if ( ! defined($files_macros_descr{$p}{$_}) || $files_macros_descr{$p}{$_} !~ /(\@|\\)deprecated/io ); # Bierzemy tylko informację o przedawnieniu # (take only the deprecation information) $descr = $files_macros_descr{$p}{$_}; $descr =~ s/^[^\@\\]*//o; while ( $descr !~ /^[\@\\]deprecated/io ) { $descr =~ s/^[\@\\][^\@\\]+//o; } $descr =~ /(\@|\\)deprecated\s+([^\@\\]*)(\@\w.*|\\\w.*|$)/io; $descr = $2; my $no_under; ($no_under = $_) =~ s/^_+//o; print $deprec "\n". "\n"; } } } print $deprec "
$depr_mac{$language}
$files_orig{$p} -- $_\n
\n". "$descr
\n"; } print $deprec "
\n".nav_bar(0, "deprecated-list.$html_ext")."
$bottom"; close $deprec; } # ============================ constant-values.html =================================== # generować plik tylko, gdy potrzebny (generate the file only if necessary) if ( $have_const ) { open(my $constv, ">:encoding($charset)", "constant-values.$html_ext") or die "$0: constant-values.$html_ext: $!\n"; print $constv "\n". "\n". "\n". "\n". "\n". "\n". "$windowtitle - $title_constants{$language}\n"; if ( $stylesheetfile eq "" ) { print $constv "\n"; } else { print $constv "\n"; } print $constv "\n".$top."
".nav_bar(1, "constant-values.$html_ext")."\n"; print $constv "

$title_constants{$language}

\n"; foreach my $p (@files) { $p = (splitpath $p)[2]; # najpierw sprawdzić, czy w danym pliku były jakiekolwiek stałe # (first check if there were any constants in the file) if ( defined($files_vars_values{$p}) ) { my @constants; foreach (%{$files_vars_values{$p}}) { if ( defined($files_vars_values{$p}{$_}) && $files_vars_values{$p}{$_} ne "" ) { push @constants, $_; } } next if scalar(@constants) < 1; print $constv "\n". "\n". "\n"; foreach (@constants) { my $no_under; ($no_under = $_) =~ s/^_+//; print $constv "\n". "\n". "\n"; } print $constv "
$files_orig{$p}
". "$_$files_vars_values{$p}{$_}

\n"; } } print $constv "
\n".nav_bar(0, "constant-values.$html_ext")."
$bottom"; close $constv; } # ============================ overview.html ================================= if ( $overview ne "" ) { open(my $over, "<:encoding($encoding)", $overview) or die "$0: $overview: $!\n"; my $contents; my $new_contents; # Pomijamy początkowy kod HTML, aż do znacznika # (Skip over initial HTML, up to the tag) do { $_ = <$over>; } while ( ! /<\s*(body|frameset)/io ); ($contents = $_) =~ s/.*<\s*(body|frameset)[^>]*>//io; # Zapisujemy całą zawartość pliku (save all the file contents) while ( <$over> ) { $contents .= $_; } close $over; $contents =~ s/<\/(body|frameset|html)>//gio; # Wstawiamy początkowy kod HTML i pasek nawigacyjny # (insert the initial HTML code and the navigation bar) $new_contents = "\n". "\n". "\n". "\n". "\n". "\n". "$windowtitle - $title_over{$language}\n"; if ( $stylesheetfile eq "" ) { $new_contents .= "\n"; } else { $new_contents .= "\n"; } $new_contents .= "\n".$top."
".nav_bar(1, $overview)."\n"; if ( $doctitle ne "" ) { $new_contents .= "

$doctitle

"; } $new_contents .= $contents . "
\n".nav_bar(0, $overview)."
$bottom"; unlink $overview; $overview = "overview-summary.$html_ext"; # Zapisujemy nową zawartość do pliku (save new file content) open($over, ">:encoding($charset)", $overview) or die "$0: $overview: $!\n"; print $over $new_contents; close $over; } # ============================ index.html ================================= # generujemy 1 index z lista wszystkich plikow jako linki (ramka z lewej okna) # (generate 1 index file with the list of all files as links (the left-hand side frame) open(my $index, ">:encoding($charset)", "index.$html_ext") or die "$0: index.$html_ext: $!\n"; print $index "\n". "\n". "\n". "\n". "\n". "\n". "$windowtitle\n"; if ( $stylesheetfile eq "" ) { print $index "\n"; } else { print $index "\n"; } print $index "\n". "\n". "\n"; if ( $overview ne "" ) { print $index "\n"; } else { print $index "\n"; } print $index "<H2>$fr_alert{$language}</H2>\n". "<P>$nofr{$language}<BR>\n"; if ( $overview ne "" ) { print $index "$linkto{$language} <A HREF=\"$overview\">$nonframe{$language}.</A>\n"; } else { print $index "$linkto{$language} <A HREF=\"".(splitpath($files[0]))[2].".$html_ext\">$nonframe{$language}.</A>\n"; } print $index "\n"; close $index; # ============================= allclasses-*.html ================================== generate_allclasses(1); # allclasses-frame generate_allclasses(0); # allclasses-noframe # ============================= stylesheet.css ================================== if ( $stylesheetfile eq "" ) { open(my $css, ">:encoding($charset)", "stylesheet.css") or die "$0: stylesheet.css: $!\n"; print $css "/* AsmDoc style sheet; see http://bogdro.evai.pl/inne/ */\n\n". "/* Define colors, fonts and other style attributes here to override the defaults */\n\n". "/* Page background color */\n". "body { background-color: #FFFFFF; color: #000000; }\n\n". "/* Headings */\n". "h1 { font-size: 145%; }\n\n". "/* Table colors */\n". ".TableHeadingColor { background: #CCCCFF; color: #000000; }\n". ".TableSubHeadingColor { background: #EEEEFF; color: #000000; }\n". ".TableRowColor { background: #FFFFFF; color: #000000; }\n\n". "/* Font used in left-hand frame lists */\n". ".FrameTitleFont { font-size: 100%; font-family: Helvetica, Arial, sans-serif; color: #000000; }\n". ".FrameHeadingFont { font-size: 90%; font-family: Helvetica, Arial, sans-serif; color: #000000; }\n". ".FrameItemFont { font-size: 90%; font-family: Helvetica, Arial, sans-serif; color: #000000; }\n". "\n/* Navigation bar fonts and colors */\n". ".NavBarCell1 { background-color: #EEEEFF; color: #000000; }\n". ".NavBarCell1Rev { background-color: #00008B; color: #FFFFFF; }\n". ".NavBarFont1 { font-family: Arial, Helvetica, sans-serif; color: #000000; }\n". ".NavBarFont1Rev { font-family: Arial, Helvetica, sans-serif; color: #FFFFFF; }\n\n". ".NavBarCell2 { font-family: Arial, Helvetica, sans-serif; background-color: #FFFFFF; color:#000000; }\n". ".NavBarCell3 { font-family: Arial, Helvetica, sans-serif; background-color: #FFFFFF; color:#000000; }\n"; close $css; } # ============================ index-all.html =================================== if ( ! $noindex ) { my @letters = ( "A" .. "Z" ); my $letter_list = ""; my $descr; open(my $indexall, ">:encoding($charset)", "index-all.$html_ext") or die "$0: index-all.$html_ext: $!\n"; print $indexall "\n". "\n". "\n". "\n". "\n". "\n". "$title_index{$language}\n"; if ( $stylesheetfile eq "" ) { print $indexall "\n"; } else { print $indexall "\n"; } print $indexall "\n".$top."
".nav_bar(1, "index-all.$html_ext")."\n"; LIT: foreach my $l (@letters) { foreach my $p (@files) { $p = (splitpath $p)[2]; foreach (@{$files_vars{$p}}) { if ( $_ =~ /^$l/i ) { print $indexall "$l "; $letter_list .= "$l "; next LIT; } } foreach (@{$files_struct{$p}}) { if ( $_ =~ /^$l/i ) { print $indexall "$l "; $letter_list .= "$l "; next LIT; } } foreach (@{$files_funcs{$p}}) { if ( $_ =~ /^$l/i ) { print $indexall "$l "; $letter_list .= "$l "; next LIT; } } foreach (@{$files_macros{$p}}) { if ( $_ =~ /^$l/i ) { print $indexall "$l "; $letter_list .= "$l "; next LIT; } } } } print $indexall "\n
\n"; foreach my $l (@letters) { if ( $letter_list =~ /($l)__/i ) { print $indexall "

$l

\n
"; foreach my $p (@files) { $p = (splitpath $p)[2]; foreach (@{$files_vars{$p}}) { if ( $_ =~ /^$l/i ) { next unless defined($files_vars_descr{$p}{$_}); $descr = $files_vars_descr{$p}{$_}; # z opisu brać tylko 1 zdanie, chyba ze zaczyna sie tagiem # (take only 1 sentence from the description unless it starts with a tag) if ( $nocomment || $descr =~ /^\s*(\@|\\)\w/o ) { $descr = ""; } else { $descr =~ s/\..*/./o; $descr =~ s/(\@|\\)[^\s].*//go; } my $no_under; ($no_under = $_) =~ s/^_+//o; print $indexall "
$_". " - $var_in_file{$language} $files_orig{$p}\n". "
".$descr; } } foreach (@{$files_struct{$p}}) { if ( $_ =~ /^$l/i ) { next unless defined($files_struct_descr{$p}{$_}); $descr = $files_struct_descr{$p}{$_}; # z opisu brać tylko 1 zdanie, chyba ze zaczyna sie tagiem # (take only 1 sentence from the description unless it starts with a tag) if ( $nocomment || $descr =~ /^\s*(\@|\\)\w/o ) { $descr = ""; } else { $descr =~ s/\..*/./o; $descr =~ s/(\@|\\)[^\s].*//go; } my $no_under; ($no_under = $_) =~ s/^_+//o; print $indexall "
$_". " - $str_in_file{$language} $files_orig{$p}\n". "
".$descr; } } foreach (@{$files_funcs{$p}}) { if ( $_ =~ /^$l/i ) { next unless defined($files_funcs_descr{$p}{$_}); $descr = $files_funcs_descr{$p}{$_}; # z opisu brać tylko 1 zdanie, chyba ze zaczyna sie tagiem # (take only 1 sentence from the description unless it starts with a tag) if ( $nocomment || $descr =~ /^\s*(\@|\\)\w/o ) { $descr = ""; } else { $descr =~ s/\..*/./o; $descr =~ s/(\@|\\)[^\s].*//go; } my $no_under; ($no_under = $_) =~ s/^_+//o; print $indexall "
$_". " - $fcn_in_file{$language} $files_orig{$p}\n". "
".$descr; } } foreach (@{$files_macros{$p}}) { if ( $_ =~ /^$l/i ) { next unless defined($files_macros_descr{$p}{$_}); $descr = $files_macros_descr{$p}{$_}; # z opisu brać tylko 1 zdanie, chyba ze zaczyna sie tagiem # (take only 1 sentence from the description unless it starts with a tag) if ( $nocomment || $descr =~ /^\s*(\@|\\)\w/o ) { $descr = ""; } else { $descr =~ s/\..*/./o; $descr =~ s/(\@|\\)[^\s].*//go; } my $no_under; ($no_under = $_) =~ s/^_+//o; print $indexall "
$_". " - $mac_in_file{$language} $files_orig{$p}\n". "
".$descr; } } } print $indexall "
\n"; } } print $indexall $letter_list."
".nav_bar(0, "index-all.$html_ext")."
$bottom"; close $indexall; } # ============================ help-doc.html =================================== if ( ! $nohelp && $helpfile eq "" ) { open(my $helpdoc, ">:encoding($charset)", "help-doc.$html_ext") or die "$0: help-doc.$html_ext: $!\n"; print $helpdoc "\n". "\n". "\n". "\n". "\n". "\n". "$title_help{$language}\n"; if ( $stylesheetfile eq "" ) { print $helpdoc "\n"; } else { print $helpdoc "\n"; } print $helpdoc "\n".$top."
".nav_bar(1, "help-doc.$html_ext")."\n
". $helpdoc_msg{$language}."
\n".nav_bar(0, "help-doc.$html_ext")."
$bottom\n"; close $helpdoc; } # =================== Zapisywanie plików wyjściowych (writing output files) ================= foreach my $p (@files) { my $descr; $p = (splitpath $p)[2]; open(my $html, ">:encoding($charset)", $p.".$html_ext") or die "$0: $p.$html_ext: $!\n"; print $html "\n". "\n". "\n". "\n". "\n". "\n". "$windowtitle - $files_orig{$p}\n"; if ( $stylesheetfile eq "" ) { print $html "\n"; } else { print $html "\n"; } print $html "\n".$top."
".nav_bar(1, $p.".$html_ext"). "

$file{$language} $files_orig{$p}

\n"; if ( defined ($files_descr{$p}) && ! $nocomment ) { if ( ! $version && $files_descr{$p} =~ /[\@\\]version/io ) { $files_descr{$p} =~ s/[\@\\]version[^\@\\]*(.*|$)/$1/ig; } if ( ! $author && $files_descr{$p} =~ /[\@\\]author/io ) { $files_descr{$p} =~ s/[\@\\]author[^\@\\]*(.*|$)/$1/ig; } if ( $nosince && $files_descr{$p} =~ /[\@\\]since/io ) { $files_descr{$p} =~ s/[\@\\]since[^\@\\]*(.*|$)/$1/ig; } if ( $nodeprecated && $files_descr{$p} =~ /[\@\\]deprecated/io ) { $files_descr{$p} =~ s/[\@\\]deprecated[^\@\\]*(.*|$)/$1/ig; } foreach my $tag (keys %tags_subst) { $files_descr{$p} =~ s/[\@\\]$tag/\n
$tags_subst{$tag}<\/B>
/ig; } print $html "
".$files_descr{$p}."\n
"; } # Podsumowanie zmiennych (variable summary) if ( defined($files_vars{$p}) && (@{$files_vars{$p}} > 0) ) { print $html "\n
\n\n". "\n". "\n". "\n"; foreach (@{$files_vars{$p}}) { next unless defined ($files_vars_descr{$p}{$_}); $descr = $files_vars_descr{$p}{$_}; # z opisu brać tylko 1 zdanie, chyba ze zaczyna sie tagiem # (take only 1 sentence from the description unless it starts with a tag) if ( $nocomment || $descr =~ /^\s*(\@|\\)\w/o ) { $descr = ""; } else { $descr =~ s/\..*/./o; $descr =~ s/(\@|\\)[^\s].*//go; } my $no_under; ($no_under = $_) =~ s/^_+//o; print $html "\n". "\n"; } print $html "
\n". "$var_sum{$language}
$_
\n". "          $descr

\n\n"; } # Podsumowanie struktur (structure summary) if ( defined($files_struct{$p}) && (@{$files_struct{$p}} > 0) ) { print $html "\n
\n\n". "\n". "\n". "\n"; foreach (@{$files_struct{$p}}) { next unless defined ($files_struct_descr{$p}{$_}); $descr = $files_struct_descr{$p}{$_}; # z opisu brać tylko 1 zdanie, chyba ze zaczyna sie tagiem # (take only 1 sentence from the description unless it starts with a tag) if ( $nocomment || $descr =~ /^\s*(\@|\\)\w/o ) { $descr = ""; } else { $descr =~ s/\..*/./o; $descr =~ s/(\@|\\)[^\s].*//go; } my $no_under; ($no_under = $_) =~ s/^_+//o; print $html "\n". "\n"; } print $html "
\n". "$str_sum{$language}
$_
\n". "          $descr

\n\n"; } # Podsumowanie funkcji (function summary) if ( defined($files_funcs{$p}) && (@{$files_funcs{$p}} > 0) ) { print $html "\n
\n\n". "\n". "\n". "\n"; foreach (@{$files_funcs{$p}}) { next unless defined ($files_funcs_descr{$p}{$_}); $descr = $files_funcs_descr{$p}{$_}; # z opisu brać tylko 1 zdanie, chyba ze zaczyna sie tagiem # (take only 1 sentence from the description unless it starts with a tag) if ( $nocomment || $descr =~ /^\s*(\@|\\)\w/o ) { $descr = ""; } else { $descr =~ s/\..*/./o; $descr =~ s/(\@|\\)[^\s].*//go; } my $no_under; ($no_under = $_) =~ s/^_+//o; print $html "\n". "\n"; } print $html "
\n". "$fcn_sum{$language}
$_
\n". "          $descr

\n\n"; } # Podsumowanie makr (macro summary) if ( defined($files_macros{$p}) && (@{$files_macros{$p}} > 0) ) { print $html "\n
\n\n". "\n". "\n". "\n"; foreach (@{$files_macros{$p}}) { next unless defined ($files_macros_descr{$p}{$_}); $descr = $files_macros_descr{$p}{$_}; # z opisu brać tylko 1 zdanie, chyba ze zaczyna sie tagiem # (take only 1 sentence from the description unless it starts with a tag) if ( $nocomment || $descr =~ /^\s*(\@|\\)\w/o ) { $descr = ""; } else { $descr =~ s/\..*/./o; $descr =~ s/(\@|\\)[^\s].*//go; } my $no_under; ($no_under = $_) =~ s/^_+//o; print $html "\n". "\n"; } print $html "
\n". "$mac_sum{$language}
$_
\n". "          $descr

\n\n"; } # Szczegóły zmiennych (variable details) if ( defined($files_vars{$p}) && (@{$files_vars{$p}} > 0) ) { print $html "\n
\n\n". "\n". "\n". "
\n". "$var_det{$language}
\n\n"; foreach (@{$files_vars{$p}}) { my $no_under; ($no_under = $_) =~ s/^_+//o; print $html "

$_

\n"; # sprawdzać, czy nie podano opcji wyłączających pewne znaczniki # (check if some options, wich disable tags, were given) if ( defined($files_vars_descr{$p}{$_}) && ! $nocomment ) { if ( ! $version && $files_vars_descr{$p}{$_} =~ /[\@\\]version/io ) { $files_vars_descr{$p}{$_} =~ s/[\@\\]version[^\@\\]*(.*|$)/$1/ig; } if ( ! $author && $files_vars_descr{$p}{$_} =~ /[\@\\]author/io ) { $files_vars_descr{$p}{$_} =~ s/[\@\\]author[^\@\\]*(.*|$)/$1/ig; } if ( $nosince && $files_vars_descr{$p}{$_} =~ /[\@\\]since/io ) { $files_vars_descr{$p}{$_} =~ s/[\@\\]since[^\@\\]*(.*|$)/$1/ig; } if ( $nodeprecated && $files_vars_descr{$p}{$_} =~ /[\@\\]deprecated/io ) { $files_vars_descr{$p}{$_} =~ s/[\@\\]deprecated[^\@\\]*(.*|$)/$1/ig; } foreach my $tag (keys %tags_subst) { $files_vars_descr{$p}{$_} =~ s/[\@\\]$tag/\n
$tags_subst{$tag}<\/B>
/ig; } print $html "
$files_vars_descr{$p}{$_}\n
\n\n"; } } } # Szczegóły struktur (structure details) if ( defined($files_struct{$p}) && (@{$files_struct{$p}} > 0) ) { print $html "\n
\n\n". "\n". "\n". "
\n". "$str_det{$language}
\n\n"; foreach (@{$files_struct{$p}}) { my $no_under; ($no_under = $_) =~ s/^_+//o; print $html "

$_

\n"; # sprawdzać, czy nie podano opcji wyłączających pewne znaczniki # (check if some options, wich disable tags, were given) if ( defined($files_struct_descr{$p}{$_}) && ! $nocomment ) { if ( ! $version && $files_struct_descr{$p}{$_} =~ /[\@\\]version/io ) { $files_struct_descr{$p}{$_} =~ s/[\@\\]version[^\@\\]*(.*|$)/$1/ig; } if ( ! $author && $files_struct_descr{$p}{$_} =~ /[\@\\]author/io ) { $files_struct_descr{$p}{$_} =~ s/[\@\\]author[^\@\\]*(.*|$)/$1/ig; } if ( $nosince && $files_struct_descr{$p}{$_} =~ /[\@\\]since/io ) { $files_struct_descr{$p}{$_} =~ s/[\@\\]since[^\@\\]*(.*|$)/$1/ig; } if ( $nodeprecated && $files_struct_descr{$p}{$_} =~ /[\@\\]deprecated/io ) { $files_struct_descr{$p}{$_} =~ s/[\@\\]deprecated[^\@\\]*(.*|$)/$1/ig; } foreach my $tag (keys %tags_subst) { $files_struct_descr{$p}{$_} =~ s/[\@\\]$tag/\n
$tags_subst{$tag}<\/B>
/ig; } print $html "
$files_struct_descr{$p}{$_}\n
\n" ."$_\n\{
\n"; foreach my $field (@{$files_struct_vars{$p}{$_}}) { next unless defined $files_struct_vars_descr{$p}{$_}{$field}; if ( ! $version && $files_struct_vars_descr{$p}{$_}{$field} =~ /[\@\\]version/io ) { $files_struct_vars_descr{$p}{$_}{$field} =~ s/[\@\\]version[^\@\\]*(.*|$)/$1/ig; } if ( ! $author && $files_struct_vars_descr{$p}{$_}{$field} =~ /[\@\\]author/io ) { $files_struct_vars_descr{$p}{$_}{$field} =~ s/[\@\\]author[^\@\\]*(.*|$)/$1/ig; } if ( $nosince && $files_struct_vars_descr{$p}{$_}{$field} =~ /[\@\\]since/io ) { $files_struct_vars_descr{$p}{$_}{$field} =~ s/[\@\\]since[^\@\\]*(.*|$)/$1/ig; } if ( $nodeprecated && $files_struct_vars_descr{$p}{$_}{$field} =~ /[\@\\]deprecated/io ) { $files_struct_vars_descr{$p}{$_}{$field} =~ s/[\@\\]deprecated[^\@\\]*(.*|$)/$1/ig; } foreach my $tag (keys %tags_subst) { $files_struct_vars_descr{$p}{$_}{$field} =~ s/[\@\\]$tag/\n
$tags_subst{$tag}<\/B>
/ig; } print $html "$field $files_struct_vars_descr{$p}{$_}{$field}
\n"; } print $html "\n\}\n
\n\n"; } } } # Szczegóły funkcji (function details) if ( defined($files_funcs{$p}) && (@{$files_funcs{$p}} > 0) ) { print $html "\n". "\n". "\n". "
\n". "$fcn_det{$language}
\n"; foreach (@{$files_funcs{$p}}) { my $no_under; ($no_under = $_) =~ s/^_+//o; print $html "

$_

\n"; # sprawdzać, czy nie podano opcji wyłączających pewne znaczniki # (check if some options, wich disable tags, were given) if ( defined($files_funcs_descr{$p}{$_}) && ! $nocomment ) { if ( ! $version && $files_funcs_descr{$p}{$_} =~ /[\@\\]version/io ) { $files_funcs_descr{$p}{$_} =~ s/[\@\\]version[^\@\\]*(.*|$)/$1/ig; } if ( ! $author && $files_funcs_descr{$p}{$_} =~ /[\@\\]author/io ) { $files_funcs_descr{$p}{$_} =~ s/[\@\\]author[^\@\\]*(.*|$)/$1/ig; } if ( $nosince && $files_funcs_descr{$p}{$_} =~ /[\@\\]since/io ) { $files_funcs_descr{$p}{$_} =~ s/[\@\\]since[^\@\\]*(.*|$)/$1/ig; } if ( $nodeprecated && $files_funcs_descr{$p}{$_} =~ /[\@\\]deprecated/io ) { $files_funcs_descr{$p}{$_} =~ s/[\@\\]deprecated[^\@\\]*(.*|$)/$1/ig; } $files_funcs_descr{$p}{$_} =~ s/[\@\\]param[^\s]*\s+([\w\:\/\(\)\[\]\%]+)/\@param $1<\/code>/gi; foreach my $tag (keys %tags_subst) { $files_funcs_descr{$p}{$_} =~ s/[\@\\]$tag/\n
$tags_subst{$tag}<\/B>
/ig; } print $html "
$files_funcs_descr{$p}{$_}\n
\n\n"; } } } # Szczegóły makr (macro details) if ( defined($files_macros{$p}) && (@{$files_macros{$p}} > 0) ) { print $html "\n". "\n". "\n". "
\n". "$mac_det{$language}
\n"; foreach (@{$files_macros{$p}}) { my $no_under; ($no_under = $_) =~ s/^_+//o; print $html "

$_

\n"; # sprawdzać, czy nie podano opcji wyłączających pewne znaczniki # (check if some options, wich disable tags, were given) if ( defined($files_macros_descr{$p}{$_}) && ! $nocomment ) { if ( ! $version && $files_macros_descr{$p}{$_} =~ /[\@\\]version/io ) { $files_macros_descr{$p}{$_} =~ s/[\@\\]version[^\@\\]*(.*|$)/$1/ig; } if ( ! $author && $files_macros_descr{$p}{$_} =~ /[\@\\]author/io ) { $files_macros_descr{$p}{$_} =~ s/[\@\\]author[^\@\\]*(.*|$)/$1/ig; } if ( $nosince && $files_macros_descr{$p}{$_} =~ /[\@\\]since/io ) { $files_macros_descr{$p}{$_} =~ s/[\@\\]since[^\@\\]*(.*|$)/$1/ig; } if ( $nodeprecated && $files_macros_descr{$p}{$_} =~ /[\@\\]deprecated/io ) { $files_macros_descr{$p}{$_} =~ s/[\@\\]deprecated[^\@\\]*(.*|$)/$1/ig; } $files_macros_descr{$p}{$_} =~ s/[\@\\]param[^\s]*\s+([\w\:\/\(\)\[\]\%]+)/\@param $1<\/code>/gi; foreach my $tag (keys %tags_subst) { $files_macros_descr{$p}{$_} =~ s/[\@\\]$tag/\n
$tags_subst{$tag}<\/B>
/ig; } print $html "
$files_macros_descr{$p}{$_}\n
\n\n"; } } } print $html "
\n".nav_bar(0, $p.".$html_ext")."
$bottom\n"; close $html; } chdir catpath($disc, $directory, ""); exit 0; # ============================ print_help =================================== sub print_help { print $msg_help{$language}; } # ============================ generate_allclasses =================================== sub generate_allclasses { my $frame = shift; my $frameid = ""; my $extra = "noframe"; if ( $frame ) { $frameid = " TARGET=\"classFrame\""; $extra = "frame" } open(my $allclfr, ">:encoding($charset)", "allclasses-$extra.$html_ext") or die "$0: allclasses-$extra.$html_ext: $!\n"; print $allclfr "\n". "\n". "\n". "\n". "\n". "\n". "$allfiles{$language}\n"; if ( $stylesheetfile eq "" ) { print $allclfr "\n"; } else { print $allclfr "\n"; } print $allclfr "\n". "$allfiles{$language}
\n\n"; foreach (@files) { $_ = (splitpath $_)[2]; print $allclfr "$files_orig{$_}
\n"; } print $allclfr "\n"; close $allclfr; } # =========================== Pasek nawigacyjny (navigation bar) =========================== sub nav_bar { if ( $nonavbar ) { return ""; } my $top = shift; # top? my $file = shift; # current file name my $result = ""; # link omijajacy pasek nawigacyjny # (a link which skips the navigation bar) if ( $top ) { $result .= "$skipbar{$language}\n"; } else { $result .= "$skipbar{$language}\n"; } $result .= "\n". "\n\n\n"; } else { $result .= "$next_file{$language}\n"; } } else { $result .= "$prev_file{$language}    $next_file{$language}\n"; } $result .= "\n"; # Linki do podsumowania i szczegółów tylko we właściwych plikach # (Add the links to summaries and details only to the correct files) if ( $file ne "help-doc.$html_ext" && $file ne "deprecated-list.$html_ext" && $file ne "index-all.$html_ext" && $file ne $helpfile && $file ne $overview && $file ne "constant-values.$html_ext" ) { $result .= "\n". ""; } $result .= "
\n". "\n". "\n"; if ( $overview ne "" ) { if ( $file ne $overview ) { $result .= ""; } else { $result .= ""; } } # Sprawdzamy, w którym pliku jesteśmy i podświetlać właściwy element paska # (check in which file we cuurently are and highlight the right element of the bar) if ( $file ne "help-doc.$html_ext" && $file ne "deprecated-list.$html_ext" && $file ne "index-all.$html_ext" && $file ne $helpfile && $file ne $overview && $file ne "constant-values.$html_ext" ) { $result .= "\n"; } else { $result .= "\n"; } if ( ! $nodeprecatedlist && -e "deprecated-list.$html_ext" ) { if ( $file ne "deprecated-list.$html_ext" ) { $result .= "\n"; } else { $result .= "\n"; } } if ( ! $noindex ) { if ( $file ne "index-all.$html_ext" ) { $result .= "\n"; } else { $result .= "\n"; } } if ( -e "constant-values.$html_ext" ) { if ( $file ne "constant-values.$html_ext" ) { $result .= "\n"; } else { $result .= "\n"; } } if ( ! $nohelp ) { if ( $helpfile eq "" ) { if ( $file ne "help-doc.$html_ext" ) { $result .= "\n"; } else { $result .= "\n"; } } else { if ( $file ne $helpfile ) { $result .= "\n"; } else { $result .= "\n"; } } } $result .= "
". "". "$title_over{$language}   ". "$title_over{$language}   ". "$file{$language}  ". "$file{$language}  ". "". "$deprec{$language}   ". "$deprec{$language}  ". "". "$title_index{$language}   ". "$title_index{$language}  ". "". "$constants{$language}   ". "$constants{$language}  ". "". "$title_help{$language}   ". "$title_help{$language}  ". "". "$title_help{$language}   ". "$title_help{$language} 
"; if ( $header ne "" && $top ) { $result .= "$header"; } elsif ( $footer ne "" && ! $top ) { $result .= "$footer"; } $result .= "
\n"; if ( $file ne "help-doc.$html_ext" && $file ne "deprecated-list.$html_ext" && $file ne "index-all.$html_ext" && $file ne $helpfile && $file ne $overview && $file ne "constant-values.$html_ext" ) { # Znajdujemy numer pliku, w którym się znajdujemy # (find the number of the file, in which we currently are) my $i=0; my $which = -1; foreach (@files) { $_ = (splitpath $_)[2]; if ( "$_.$html_ext" eq $file ) { $which = $i; last; } $i++; } # Linki "Następny" i "Poprzedni" (the "NEXT" and "PREV" links) if ( $which > 0 && $which <= $#files ) { $result .= "$prev_file{$language}  \n"; } else { $result .= "$prev_file{$language}    \n"; } if ( $which >= 0 && $which < $#files ) { $result .= "$next_file{$language}\n". "$name_frames{$language}   \n". "$no_frames{$language}   \n". "$allfiles{$language}\n\n". "
\n". "$summary{$language}: ". "$name_vars{$language} | ". "$name_st{$language} | ". "$name_fcns{$language} | ". "$name_mc{$language}\n". "$details{$language}: ". "$name_vars{$language} | ". "$name_st{$language} | ". "$name_fcns{$language} | ". "$name_mc{$language}
\n"; # cel linku omijajacego pasek nawigacyjny # (target of the link, which skips the navigation bar) if ( $top ) { if ( $doctitle ne "" ) { $result .= "\n\n". "

$doctitle

\n\n"; } else { $result .= "\n\n"; } } else { $result .= "\n\n"; } return $result; } # ============================== tags ===================================== sub tags { my $current = shift; return $current if ( ! defined ($current) ); # {@code} if ( $current =~ /\{\s*(\@|\\)code\s*(.*)\}/io ) { my $descr = $2; # zamieniamy zabronione znaki na encje HTML # (changing forbidden characters to HTML entities) $descr =~ s/&($|[^a])($|[^m])($|[^p])/&$1$2$3/ig; $descr =~ s/<(\s|$)/<$1/g; $descr =~ s/>(\s|$)/>$1/g; $current =~ s/\{\s*(\@|\\)code\s*(.*)\}/$descr<\/CODE>/ig; } # {@literal} if ( $current =~ /\{\s*(\@|\\)literal\s*(.*)\}/io ) { my $descr = $2; # zamieniamy zabronione znaki na encje HTML # (changing forbidden characters to HTML entities) $descr =~ s/&($|[^a])($|[^m])($|[^p])/&$1$2$3/ig; $descr =~ s/<(\s|$)/<$1/g; $descr =~ s/>(\s|$)/>$1/g; $current =~ s/\{\s*(\@|\\)literal\s*(.*)\}/$descr/ig; } # {@docroot} $current =~ s/\{\s*(\@|\\)docroot\s*\}/$docroot/ig; # {@link} if ( $current =~ /\{\s*(\@|\\)link\s*(.*)\s+(.*)\}/io ) { my $target = $2; my $label = $3; my $file; my $have_file = 0; if ( $target =~ /\#(\w+)/o ) { $target =~ s/\#(\w+)\([^\)]\)/\#$1/g; $file = ""; $have_file = 1; } if ( $target =~ /^([\w\.\-\+]+)/o ) { my $file = $1; foreach (@files) { $_ = (splitpath $_)[2]; $have_file = 1 if /$file/i; } $file =~ s/\./-/go; } $target =~ s/^([\w\.\-\+]+)/$file.$html_ext/ if $have_file; $current =~ s/\{\s*(\@|\\)link\s*(.*)\s+(.*)\}/$label<\/CODE><\/A>/ig; } if ( $current =~ /\{\s*(\@|\\)link\s*(.*)\}/io ) { my $target = $2; my $file; my $have_file = 0; if ( $target =~ /\#(\w+)/o ) { $target =~ s/\#(\w+)\([^\)]\)/\#$1/g; $file = ""; $have_file = 1; } if ( $target =~ /^([\w\.\-\+]+)/o ) { my $file = $1; foreach (@files) { $_ = (splitpath $_)[2]; $have_file = 1 if /$file/i; } $file =~ s/\./-/go; } $target =~ s/^([\w\.\-\+]+)/$file.$html_ext/ if $have_file; $current =~ s/\{\s*(\@|\\)link\s*(.*)\s+(.*)\}/$target<\/CODE><\/A>/ig; } # {@linkplain} if ( $current =~ /\{\s*(\@|\\)linkplain\s*(.*)\s+(.*)\}/io ) { my $target = $2; my $label = $3; my $file; my $have_file = 0; if ( $target =~ /\#(\w+)/o ) { $target =~ s/\#(\w+)\([^\)]\)/\#$1/g; $file = ""; $have_file = 1; } if ( $target =~ /^([\w\.\-\+]+)/o ) { my $file = $1; foreach (@files) { $_ = (splitpath $_)[2]; $have_file = 1 if /$file/i; } $file =~ s/\./-/go; } $target =~ s/^([\w\.\-\+]+)/$file.$html_ext/ if $have_file; $current =~ s/\{\s*(\@|\\)linkplain\s*(.*)\s+(.*)\}/$label<\/A>/ig; } if ( $current =~ /\{\s*(\@|\\)linkplain\s*(.*)\}/io ) { my $target = $2; my $file; my $have_file = 0; if ( $target =~ /\#(\w+)/o ) { $target =~ s/\#(\w+)\([^\)]\)/\#$1/g; $file = ""; $have_file = 1; } if ( $target =~ /^([\w\.\-\+]+)/o ) { my $file = $1; foreach (@files) { $_ = (splitpath $_)[2]; $have_file = 1 if /$file/i; } $file =~ s/\./-/go; } $target =~ s/^([\w\.\-\+]+)/$file.$html_ext/ if $have_file; $current =~ s/\{\s*(\@|\\)linkplain\s*(.*)\s+(.*)\}/$target<\/A>/ig; } # @see if ( $current =~ /(\@|\\)see\s*([^\s]+)\s+([^\s]+)/io && $current !~ /(\@|\\)see\s*$label<\/A>/ig; } else { $current =~ s/(\@|\\)see\s*([^\s]+)\s+([^\s]+)/\@see $label/ig; } } if ( $current =~ /(\@|\\)see\s*([^\s]+)/io && $current !~ /(\@|\\)see\s*$target_st<\/A>/ig; } else { $current =~ s/(\@|\\)see\s*([^\s]+)/\@see $target/ig; } } return $current; }