Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Dear Perl Monks, I have an array of filenames.i want to write this array of filenames into a file based on some pattern in the file names (in this case bakery or fruitjunction). 
/home/units/bakery/cake.pl
/home/units/bakery/pie.pl
/home/units/bakery/plumcake.pl
/home/units/fruitjunction/juice.pl
/home/units/fruitjunction/icecream.pl
/home/units/bakery/choclate.pl

[download]
what i would like 
1. it should maitain the same order as listed.
2. based on the pattern (bakery|fruitjunction) it should add some patt
+ern

[download]
it would be something like in the file i am writing... 
# BAKERY
/home/units/bakery/cake.pl
/home/units/bakery/pie.pl
/home/units/bakery/plumcake.pl
# END BAKERY
# FRUITJUNCTION
/home/units/fruitjunction/juice.pl
/home/units/fruitjunction/icecream.pl
# END FRUITJUNCTION
# BAKERY
/home/units/bakery/choclate.pl
# END BAKERY

[download]
currently my code is 
my @bakery;
my @fruitjunction;
foreach my $file ( @filenames) {
push (@bakery,$file) if($file =~ /bakery/) ;
push (@fruitjunction,$file) ($file =~ /fruitjunction/);
}
if(scalar(@bakery)) {
print WRITE "# BAKERY \n";
print WRITE @bakery;
print WRITE "# END BAKERY \n";
}
if(scalar(@fruitjunction)) {
print WRITE "# FRUITJUNCTION \n";
print WRITE @fruitjunction;
print WRITE "# END FRUITJUNCTION \n";
}

[download]
but i am unable to maintain the order of the files . similiar type is required for one of the modules in my project and hence i have changed the name of the files .... Thanks,

Replies are listed 'Best First'.
Re: insert lines based on some pattern
by bobf (Monsignor) on Feb 16, 2007 at 06:52 UTC

    This example will use the last directory as the label, so it is not limited to using just BAKERY or FRUITJUNCTION and it won't break if those patterns occur elsewhere in the path (see the last two example paths). 

    use strict;
use warnings;

# for portable path and filename operations
use File::Spec;

my @paths = qw(
                /home/units/bakery/cake.pl
                /home/units/bakery/pie.pl
                /home/units/bakery/plumcake.pl
                /home/units/fruitjunction/juice.pl
                /home/units/fruitjunction/icecream.pl
                /home/units/bakery/choclate.pl
                /home/bakery/fruitjunction/not_a_bakery.pl
                /home/units/foo/bar.pl
            );

my $current_dir = '';

foreach my $path ( @paths )
{
    chomp $path;

    # retrieve the last directory in the path
    my $dir = get_dir( $path );

    # print a start label if this is the first path
    if( $current_dir eq '' )
    {
        $current_dir = uc( $dir );
        print "# $current_dir\n";
    }

    # change labels if required
    if( uc( $dir ) ne $current_dir )
    {
        print "# END $current_dir\n";
        $current_dir = uc( $dir );
        print "# $current_dir\n";
    }

    print "$path\n";
}

print "# END $current_dir\n";

sub get_dir
{
    my ( $path ) = @_;

    # extract the directory portion of the path
    my ( undef, $dirs, undef ) = File::Spec->splitpath( $path );

    # remove trailing directory separators
    $dirs = File::Spec->canonpath( $dirs );

    # split the path on directory separators
    my @dir = File::Spec->splitdir( $dirs );

    return $dir[-1];
}

    [download]
    Output: 
    # BAKERY
/home/units/bakery/cake.pl
/home/units/bakery/pie.pl
/home/units/bakery/plumcake.pl
# END BAKERY
# FRUITJUNCTION
/home/units/fruitjunction/juice.pl
/home/units/fruitjunction/icecream.pl
# END FRUITJUNCTION
# BAKERY
/home/units/bakery/choclate.pl
# END BAKERY
# FRUITJUNCTION
/home/bakery/fruitjunction/not_a_bakery.pl
# END FRUITJUNCTION
# FOO
/home/units/foo/bar.pl
# END FOO

    [download]

[reply]
[d/l]
[select]
Re: insert lines based on some pattern
by ikegami (Patriarch) on Feb 16, 2007 at 06:32 UTC 
    use strict;
use warnings;

{
   my @filenames = ...;
   my $fn_out    = ...;

   open(my $fh_out, '>', $fn_out)
      or die("Unable to create file \"$fn_out\": $!\n");

   my $last;
   foreach my $file (@filenames) {
      my ($this) = $file =~ m{/(bakery|fruitjunction)/};
      if (!defined($last)) {
         print $fh_out ("# ", uc($this), "\n");
      }
      elsif ($last ne $this) {
         print $fh_out ("# END ", uc($last), "\n");
         print $fh_out ("# ",     uc($this), "\n");
      }
      $last = $this;
      print $fh_out ($file, "\n");
   }

   if (defined($last)) {
      print $fh_out ("# END ", uc($last), "\n");
   }
}

    [download]
[reply]
[d/l]
Re: insert lines based on some pattern
by Mandrake (Chaplain) on Feb 16, 2007 at 07:03 UTC
    By the term "order", do you mean similar ones should be grouped ?
    If so, a quick solution can be 
    my %hash;
for (@filenames) {
   chomp;
   push @{$hash{$3}}, $_  if ($_ =~ /(.+)\/(.+)\/(.+)\/.+/);
}

for (keys %hash) {
   print "#".uc($_)."\n" ;
   print $_."\n" for (@{$hash{$_}});
   print "#END ".uc($_)."\n" ;
}

    [download]
    This uses a hash. You can print the output to a file.
[reply]
[d/l]
      If you look carefully at the sample output, you will see that the order of the files is maintained with files in the same type to be "surrounded" by "bakery" or "fruitjunction" tags.

      Your hash-of-arrays will not keep this "interleaved" order.

      CountZero

      "If you have four groups working on a compiler, you'll get a 4-pass compiler." - Conway's Law

[reply]

Back to Seekers of Perl Wisdom