How can I get & parse the content of the first line?

[michael3]

Hi,

I've messed up my file names on NT when tar'd them from Solaris. I packed them on NT, then I unpacked the tar file back on Solaris, all the files are lower-cased. I have writen each of my file name at the begening of the file, take an example for vincrement.java, as you can see, it should be named as VIncrement.java, instead:

/* VIncrement.java */

package com.dot.ext.math;

import com.dot.lex.objects.*;
import com.dot.project.*;
import com.dot.lex.engine.*;
import com.dot.utils.*;

/**
* The increment verb increments a number object by one.
*/
public class VIncrement extends VVerb implements VerbI
{
// ...
}

Now I want to do the reverse engineering for my whole file structures with Perl. I'd like the perl program will read only the first line of each file, and rename the current file to the correct one. Can I use find() like this?

Many thanks,

Michael

#!/usr/bin/perl

use File::Find;

sub change {

if( -f && /\.java$/ ) {

my $in = $_;
#How Can I Get only the first line and filt out the /* */?
my $out = ???;

open( IN, $in ) or die;
open( OUT, ">$out" ) or die;

close IN;
close OUT;

rename( $out, $in );
}
}

my @dirs = qw(.);

if ($#ARGV+1 == 2) {
find ( \&change, @dirs );
}else {
print "Usage: !";
exit;
}

 

[esserc]

Here ya go:

A quick and dirty way of doing it:

sub renamefile {
   my $filename = shift;
   my $line;

   open (INFILE, "$filename") or die;
   $line = <INFILE>; # Read first line
   chomp($line);     # Remove CR, CR/LF
   close(INFILE);
   $line =~ s/\/\*//g; # Remove comments
   $line =~ s/\*\///g; # Remove comments
   $line =~ s/\s+//g;  # Remove whitespaces
   print &quot;Renaming $filename to $line\n&quot;;
   rename $filename, $line
}

Hope this helps.

 

[hmerrill]

Read the perldocs on the File::Find module by doing

perldoc File::Find

at a command prompt.

Looks to me like in the "change" subroutine, you'll need to use the package variable(s) $File::Find::dir and/or $File::Find::name to get the name of the current file that is being processed. I think those are what you need to properly build $out.

HTH. Hardy Merrill
Mission Critical Linux, Inc.

http://www.missioncriticallinux.com

 

[michael3]

Hi,

Thanks a lot for the help. Here is the solution I put together.

##########################################
#!/usr/bin/perl
use File::Find;
sub renamefile {
if( -f && /\.java$/ ) {
my $filename = $_;
my $line;
open (INFILE, "$filename&quot or die;
$line = <INFILE>; # Read first line
chomp($line); # Remove CR, CR/LF
close(INFILE);
$line =~ s/\/\*//g; # Remove comments
$line =~ s/\*\///g; # Remove comments
$line =~ s/\s+//g; # Remove whitespaces
print &quot;Renaming $filename to $line\n&quot;;

rename $filename, $line
}
}

my @dirs = qw(.);
#print &quot;argument: $1\n&quot;;
#my @dirs = qw($1);

if ($#ARGV+1 == 1) {
find ( \&renamefile, @dirs );
}else {
print &quot;Usage: renameF.pl dir_name!&quot;;
exit;
}
#########################################

It works well from the current directory. Can anybody give me some hint HOW CAN I PASS AN ARGUMENT(DIRECTORY NAME) to qw($WHERE)? Should I make $filename a globe var? Thanks.

Michael

 

[hmerrill]

Explain more what you *want* to be able to do - you want to be able to pass the directory name to $where - what is $where? Hardy Merrill
Mission Critical Linux, Inc.

http://www.missioncriticallinux.com

 

[michael3]

yes. I need the qw() to take a commandline argument (dir_name), so that the perl script can run from anywhere instead of only current directory.

michael

 

[hmerrill]

As with most things in Perl, passing parameters into a script can be done more than one way. Probably the easiest way I can think of is to &quot;shift&quot; off command line arguments to your script, like:

#!/usr/bin/perl -w
use strict;
my $directory_param = shift;

-------------------------------------------------------

If that script was called &quot;test&quot;, then you could
run test like this:

test /path/to/directory

and $directory_param would end up containing
&quot;/path/to/directory&quot;.

Using &quot;shift&quot; in this way shift's off the 1st(and only in this case) parameter from the parameter list contained in the @ARGV array.

Another way is to use the Getopt::Std module, which comes with the core Perl distribution - read about that by doing

perldoc Getopt::Std

HTH. Hardy Merrill
Mission Critical Linux, Inc.

http://www.missioncriticallinux.com

 

[michael3]

Thanks, Hardy. I got it.

michael

 

[esserc]

Just in case you need it, here's a full working script that will recursivly fix all the files in the directories below where the program is run:

#!/usr/local/bin/perl

open (FILES, "find .|") or die "Cannot run find: $!\n";
foreach $file (<FILES>) {
   chomp($file);
   if ($file =~ /\.java$/) {
      &renamefile($file);
   }
}
close(FILES);

sub renamefile {
   my $filename = shift;
   my $line;
   my $dir;
   my @dirarray;
   my $newfile;
   
   @dirarray = split('/', $filename);
   pop (@dirarray);
   $dir=join('/',@dirarray);

   open (INFILE, &quot;$filename&quot;) or die;
   $line = <INFILE>; # Read first line
   chomp($line);     # Remove CR, CR/LF
   close(INFILE);
   $line =~ s/\/\*//g; # Remove comments
   $line =~ s/\*\///g; # Remove comments
   $line =~ s/\s+//g;  # Remove whitespaces
   $newfile = &quot;$dir/$line&quot;;
   print &quot;Renaming $filename to $newfile\n&quot;;
   rename $filename, $newfile
}