Вопрос по перлу

hasuhands · 05.08.2005

Есть скрипт, которые удаляет комментарии из c++ файлов

Код:

# Clear Internal Comments
# Author: (c) Martinov G.M.
# created 18.01.2003 v.0.0.1
# modified 04.05.2003 v.0.0.2 - GM
#  1. trace the founded internal comments
#  2. adapt command line arguments to Windows XP


$sourcePath = 'C:\NCsSoft';         # value by default
$fileTypes = '(.h$)|(.cpp$)|(.hpp$)';    # value by default
$silent = 0;                # switch on/off traces 
$version = "0.0.2";             


# ============= sub ClearInternalComments ====================================================
# Clear Internal comments
#Parameters: $_[0] - file name
sub ClearInternalComments 
{         
#Parameters: $_[0] - file name 
undef $/ if ($/ eq "\n" );          # mode of absorption whole file

open HANDLE, $_[0] or die "Cant open $_[0]: $!";
$_ = <HANDLE>;

# print;   # for debug
s%
  # Сначало перечисляется то, что совпадает но не удаляется
  (
    [^"'/]+                # Все остальное 
   |                    # or
    (?:"[^"\\]*(?:\\.[^"\\]*)*" [^"'/]*)+ # line in double quotes
   |
    (?:'[^"\\]*(?:\\.[^'\\]*)*' [^"'/]*)+ # line in quotes (апостьроф)
   |                    # or
  ) 
 |
    # ... коментарий. Поскольку он не совпал с круглами скобками $1,
    # коментарии исчезнут, когда мы используем $1 в качестве текста замены.
    / (?:                 # любой коментарий начинается с косой чертой
      \*[^*]*\*+(?:[^/*][^*]*\*+)*/   # Traditional comment of C
    |                   # or
     /[^\n]*               # Coment of C++ (//)
     )
%$1%gsx;

close HANDLE;
open HANDLE, ">$_[0]" or die "Cant open $_[0] for writing: $!";
print HANDLE $_;         # print in destination file without comments

#------------------

close HANDLE;

$/ = "\n" if ($/ ne "\n" );          #define again
# print;   # for debug
return $_;
} # End sub ClearC++Coments 


# ============= sub DirLoop ====================================================
# parametr $_[0] is DirName
sub DirLoop       
{ 
opendir (CURRENT_DIR, $_[0]) 
 or die "Cant open $_[0]: $!";

print "----------------------------------- \n" if($silent == 0); # TRACE
print "Open dir $_[0] \n" if($silent == 0); # TRACE

# directory loop
foreach $File (readdir CURRENT_DIR) 
{
 if (-f "$_[0]/$File" && $File=~m/\w+$fileTypes/i)
 { # one of files
  &ClearInternalComments("$_[0]/$File"); 
 }
 elsif (-d "$_[0]/$File" && $File=~m/\w+/ )
 { # subdirectory
  &DirLoop("$_[0]/$File");
 }
}
closedir(CURRENT_DIR);
}

#===============================================================================
==

print "> $0 ".join (', ', @ARGV)."\n\n";; # TRACE start line

print "Clear internal comments, Internal_conments_x.pl version $version \n\n" if($silent == 0); # trace

#------------ command line arguments handling
if ( $ARGV[0] eq '/?' || $ARGV[0] eq '|?' || $ARGV[0] eq '-?')
{ # help call
print " command line: %perl Internal_conments_x.pl [-?] [/?] [|?]\n"."      or \n";
print "       : %perl Internal_conments_x.pl [SourcePath] [FileTypes] [-s]\n";
print " arguments: \n  [/?] or [|?] - this help\n";
print "  [SourcePath] - path to source subdirectory\n  [FileTypes] - file type to be cleared (delimiter is symbol ':')\n";
print "  [-s]     - silent\n\n";
print " exempla for analyzing *.h and *.cpp files:\n  %perl Internal_conments_x.pl $sourcePath *.h:*.cpp\n";
$#ARGV = -1; 
print "\n"."Press <Enter> to close"; 
exit if ( <> );
}
elsif ($#ARGV > -1)
{ # handling arguments for path and file type
$sourcePath = $ARGV[0]  if (-d $ARGV[0]);

@FileTypeArray = split(/:/, $ARGV[1]);
foreach $TypeItem (@FileTypeArray)
{
 $TypeItem =~ s/\*//;          # delete '*'
 $TypeItem = '('.$TypeItem.'$)';     # like (.h$)
}
$ARGV[1] = join('|', @FileTypeArray);
$fileTypes = $ARGV[1]   if ($ARGV[1] ne ''); 

$silent = 1  if ($ARGV[2] =~ m/^-s$/i);
$#ARGV = -1;               # clear arguments
}

#----------------------------
-e($sourcePath) or die " Directory $sourcePath doesn't exist $!";
print "Looking in node: $sourcePath\n"."for files with extension: $fileTypes\n \n";

&DirLoop($sourcePath);

print "End! Press <Enter> to close"; <>

Скрипт не мой. При тестировании скрипта на своих прирах все работало хорошо. Как только начал использовать его в полевый условиях - начал глючить. Например, следующий файл парсится очень коряво:

Код:

/* -*- Mode: C++; tab-width: 2; indent-tabs-mode: nil; c-basic-offset: 2 -*- */
#include "nsIAtom.h"
#include "nsParserNode.h" 
#include <string.h>
#include "nsHTMLTokens.h"
#include "nsITokenizer.h"
#include "nsDTDUtils.h"


/**
* Default Constructor
*/
nsCParserNode::nsCParserNode()
: mToken(nsnull),
 mUseCount(0),
 mGenericState(PR_FALSE),
 mTokenAllocator(nsnull)
{
MOZ_COUNT_CTOR(nsCParserNode);
#ifdef HEAP_ALLOCATED_NODES
mNodeAllocator = nsnull;
#endif
}

/**
* Constructor
* 
* @update gess 3/25/98
* @param  aToken -- token to init internal token
* @return 
*/
nsCParserNode::nsCParserNode(CToken* aToken,
              nsTokenAllocator* aTokenAllocator,
              nsNodeAllocator* aNodeAllocator): nsIParserNode() 
{
mRefCnt = 0;
MOZ_COUNT_CTOR(nsCParserNode);

static int theNodeCount = 0;
++theNodeCount;
mToken = aToken;
IF_HOLD(mToken);
mTokenAllocator = aTokenAllocator;
mUseCount = 0;
mGenericState = PR_FALSE;
#ifdef HEAP_ALLOCATED_NODES
mNodeAllocator = aNodeAllocator;
#endif
}

/**
* default destructor
* NOTE: We intentionally DONT recycle mToken here.
*    It may get cached for use elsewhere
* @update gess 3/25/98
* @param  
* @return 
*/
nsCParserNode::~nsCParserNode() {
MOZ_COUNT_DTOR(nsCParserNode);
ReleaseAll();
#ifdef HEAP_ALLOCATED_NODES
if(mNodeAllocator) {
 mNodeAllocator->Recycle(this);
}
mNodeAllocator = nsnull;
#endif
mTokenAllocator = 0;
}


/**
* Init
* 
* @update gess 3/25/98
* @param  
* @return 
*/

nsresult
nsCParserNode::Init(CToken* aToken,
         nsTokenAllocator* aTokenAllocator,
         nsNodeAllocator* aNodeAllocator) 
{
mTokenAllocator = aTokenAllocator;
mToken = aToken;
IF_HOLD(mToken);
mGenericState = PR_FALSE;
mUseCount=0;
#ifdef HEAP_ALLOCATED_NODES
mNodeAllocator = aNodeAllocator;
#endif
return NS_OK;
}

void
nsCParserNode::AddAttribute(CToken* aToken) 
{
}


/**
* Gets the name of this node. Currently unused.
* 
* @update gess 3/25/98
* @param  
* @return string ref containing node name
*/
const nsAString&
nsCParserNode::GetTagName() const {
return EmptyString();
}


/**
* Get text value of this node, which translates into 
* getting the text value of the underlying token
* 
* @update gess 3/25/98
* @param  
* @return string ref of text from internal token
*/
const nsAString& 
nsCParserNode::GetText() const 
{
if (mToken) {
 return mToken->GetStringValue();
}
return EmptyString();
}

/**
* Get node type, meaning, get the tag type of the 
* underlying token
* 
* @update gess 3/25/98
* @param  
* @return int value that represents tag type
*/
PRInt32 
nsCParserNode::GetNodeType(void) const
{
return (mToken) ? mToken->GetTypeID() : 0;
}


/**
* Gets the token type, which corresponds to a value from
* eHTMLTokens_xxx.
* 
* @update gess 3/25/98
* @param  
* @return 
*/
PRInt32 
nsCParserNode::GetTokenType(void) const
{
return (mToken) ? mToken->GetTokenType() : 0;
}


/**
* Retrieve the number of attributes on this node
* 
* @update gess 3/25/98
* @param  
* @return int -- representing attribute count
*/
PRInt32 
nsCParserNode::GetAttributeCount(PRBool askToken) const
{
return 0;
}

/**
* Retrieve the string rep of the attribute key at the
* given index.
* 
* @update gess 3/25/98
* @param  anIndex-- offset of attribute to retrieve
* @return string rep of given attribute text key
*/
const nsAString&
nsCParserNode::GetKeyAt(PRUint32 anIndex) const 
{
return EmptyString();
}


/**
* Retrieve the string rep of the attribute at given offset
* 
* @update gess 3/25/98
* @param  anIndex-- offset of attribute to retrieve
* @return string rep of given attribute text value
*/
const nsAString&
nsCParserNode::GetValueAt(PRUint32 anIndex) const 
{
return EmptyString();
}

PRInt32 
nsCParserNode::TranslateToUnicodeStr(nsString& aString) const
{
if (eToken_entity == mToken->GetTokenType()) {
 return ((CEntityToken*)mToken)->TranslateToUnicodeStr(aString);
}
return -1;
}

/**
* This getter retrieves the line number from the input source where
* the token occured. Lines are interpreted as occuring between \n characters.
* @update	gess7/24/98
* @return int containing the line number the token was found on
*/
PRInt32
nsCParserNode::GetSourceLineNumber(void) const {
return mToken ? mToken->GetLineNumber() : 0;
}

/**
* This method pop the attribute token
* @update	harishd 03/25/99
* @return token at anIndex
*/

CToken* 
nsCParserNode::PopAttributeToken() {
return 0;
}

/** Retrieve a string containing the tag and its attributes in "source" form
* @update	rickg 06June2000
* @return void
*/
void 
nsCParserNode::GetSource(nsString& aString) 
{
eHTMLTags theTag = mToken ? (eHTMLTags)mToken->GetTypeID() : eHTMLTag_unknown;
aString.Assign(PRUnichar('<'));
const PRUnichar* theTagName = nsHTMLTags::GetStringValue(theTag);
if(theTagName) {
 aString.Append(theTagName);
}
aString.Append(PRUnichar('>'));
}

/** Release all the objects you're holding to.
* @update	harishd 08/02/00
* @return void
*/
nsresult 
nsCParserNode::ReleaseAll() 
{
if(mTokenAllocator) {
 IF_FREE(mToken,mTokenAllocator);
}
return NS_OK;
}

nsresult 
nsCParserStartNode::Init(CToken* aToken,
            nsTokenAllocator* aTokenAllocator,
            nsNodeAllocator* aNodeAllocator) 
{
NS_ASSERTION(mAttributes.GetSize() == 0, "attributes not recycled!");
return nsCParserNode::Init(aToken, aTokenAllocator, aNodeAllocator);
}

void nsCParserStartNode::AddAttribute(CToken* aToken) 
{
NS_ASSERTION(0 != aToken, "Error: Token shouldn't be null!");
mAttributes.Push(aToken);
}

PRInt32 
nsCParserStartNode::GetAttributeCount(PRBool askToken) const
{
PRInt32 result = 0;
if (askToken) {
 result = mToken ? mToken->GetAttributeCount() : 0;
}
else {
 result = mAttributes.GetSize();
}
return result;
}

const nsAString&
nsCParserStartNode::GetKeyAt(PRUint32 anIndex) const 
{
if ((PRInt32)anIndex < mAttributes.GetSize()) {
 CAttributeToken* attr = 
  NS_STATIC_CAST(CAttributeToken*, mAttributes.ObjectAt(anIndex));
 if (attr) {
  return attr->GetKey();
 }
}
return EmptyString();
}

const nsAString&
nsCParserStartNode::GetValueAt(PRUint32 anIndex) const 
{
if (PRInt32(anIndex) < mAttributes.GetSize()) {
 CAttributeToken* attr = 
  NS_STATIC_CAST(CAttributeToken*, mAttributes.ObjectAt(anIndex));
 if (attr) {
  return attr->GetValue();
 }
}
return EmptyString();
}

CToken* 
nsCParserStartNode::PopAttributeToken() 
{
return NS_STATIC_CAST(CToken*, mAttributes.Pop());
}

void nsCParserStartNode::GetSource(nsString& aString) 
{
aString.Assign(PRUnichar('<'));
const PRUnichar* theTagName = 
 nsHTMLTags::GetStringValue(nsHTMLTag(mToken->GetTypeID()));
if (theTagName) {
 aString.Append(theTagName);
}
PRInt32 index;
PRInt32 size = mAttributes.GetSize();
for (index = 0; index < size; ++index) {
 CAttributeToken *theToken = 
  NS_STATIC_CAST(CAttributeToken*, mAttributes.ObjectAt(index));
 if (theToken) {
  theToken->AppendSourceTo(aString);
  aString.Append(PRUnichar(' ')); //this will get removed...
 }
}
aString.Append(PRUnichar('>'));
}

nsresult nsCParserStartNode::ReleaseAll() 
{
NS_ASSERTION(0!=mTokenAllocator, "Error: no token allocator");
CToken* theAttrToken;
while ((theAttrToken = NS_STATIC_CAST(CToken*, mAttributes.Pop()))) {
 IF_FREE(theAttrToken, mTokenAllocator);
}
nsCParserNode::ReleaseAll();
return NS_OK; 
}

После рарсинга, например, остается:

Код:

/** Release all the objects you're holding to.
* @update	harishd 08/02/00
* @return void
*/

Помогите разобраться с регеспами. Пожалуйста. Код не мой - очень сложно понять, что имел в виду разработчик.

???? · 05.08.2005

Для: hasuhands

Ссылка скрыта от гостей

$stripped_text = $snoop->stripped("program.c");

Strip all comments from a file. After determining the file type by either suffix or content ("Cold Calls"), all comments are removed and the stripped text is returned in a scalar.

Guest · 06.08.2005

Для: ????
Спасибо. Все отлично работает

hasuhands · 06.08.2005

Вернее не все. Установи последние версии модулей. Во время попытки парсинга *.pl файлов вылетает ошибка

Код:

API CHANGE: Source code should only be passed to PPI::Document->new as a SCALAR
reference at C:/Perl/lib/PPI/Document.pm line 126.

# Catch people using the old API
if ( $_[0] =~ /(?:\012|\015)/ ) {
die "API CHANGE: Source code should only be passed to PPI::Document->new as a SCALAR reference";
}

Видимо одна из библиотек использует старый API

hasuhands · 06.08.2005

Постаивл более старую версию IO-stringy (после нее появилась вышеобозначенная ошибка). Теперь вылетает следующее:

Код:

Base class package "IO::Handle" is empty.
 (Perhaps you need to 'use' the module which defines that package first.)
at C:/Perl/lib/File/Temp.pm line 139
BEGIN failed--compilation aborted at C:/Perl/lib/File/Temp.pm line 139.
Compilation failed in require at C:/Perl/lib/Sysadm/Install.pm line 19.
BEGIN failed--compilation aborted at C:/Perl/lib/Sysadm/Install.pm line 19.
Compilation failed in require at C:/Perl/lib/File/Comments.pm line 12.
BEGIN failed--compilation aborted at C:/Perl/lib/File/Comments.pm line 12.
Compilation failed in require at C:\Perl_src\extract-comments.pl line 8.
BEGIN failed--compilation aborted at C:\Perl_src\extract-comments.pl line 8.

Теперь, что делать не знаю...

???? · 06.08.2005

Для: hasuhands
сори... я систему переустанавливаю - перла пока нет, проверить/покрутить не могу...
может через пару дней, если вспомню

Все сервисы Codeby

Поиск

Поиск

Вопрос по перлу

hasuhands

????

Guest

hasuhands

hasuhands

????