Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Two subroutine: Compare and contrast

by Win (Novice)
on Feb 14, 2007 at 11:18 UTC ( [id://599910]=perlquestion: print w/replies, xml ) Need Help??

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

This node falls below the community's threshold of quality. You may see it by logging in.

Replies are listed 'Best First'.
Re: Two subroutines: Compare and contrast
by davorg (Chancellor) on Feb 14, 2007 at 11:32 UTC
    ###############################THE BIT THAT FOLLOWS DOES NOT WORK while ($_ = (readdir DIR)) { # print $_, "\n"; if (-d $_) { print "This is a dir $_ \n"; if ($_ =~ /^\d/){ ##if directory name is a number print "This directory is a number: $_"; push (@directories, $_); } } }

    Perhaps you'd consider explaining in what way this code "DOES NOT WORK"?

    Have you tried debugging the subroutine? Stepping through it a line at a time? Looking at the contents of the variables? Working out where it differs from what you are expecting?

    Doing, in short, the kinds of things that a programmer would do to try and solve a problem like this.

    A reply falls below the community's threshold of quality. You may see it by logging in.
Re: Two subroutine: Compare and contrast
by marto (Cardinal) on Feb 14, 2007 at 12:39 UTC
    " If there is anyone out there that can fix it I will assume that it is worth using this more advanced version, otherwise I will assume that it is too complex and shouldn't be used."

    To me this reads like you want someone to go to the effort of fixing a problem which you have not detailed, in code that you did not write. You have posted previous questions which are along the lines of 'I need to Perl code to achieve a,b and c....". As davorg has previously stated, you seem to have made no effort in even telling us what is not working. You repeatedly seem unwilling to debug anything. If you find something 'complex' and don't understand what is going on, take davorg's advice and break the problem down and work out what is going on, then you will see how to go about fixing it. I found it odd that you posted this request for someone else to do something you are being paid to do, after you posted this. For a second I thought you would start making some effort. If you had taken your own 'advice' you could have found Debugging and Optimization.
    A reply falls below the community's threshold of quality. You may see it by logging in.
Re: Two subroutine: Compare and contrast
by graff (Chancellor) on Feb 15, 2007 at 08:16 UTC
    Hello again, Win.

    If the first subroutine is your own effort, then it seems like you've made some good progress since the last time I replied to one of your threads. Congrats on having a subroutine that actually seems to work. (You may want to consider these "Words of Holy Wisdom"... If it ain't broke, don't fix it. -- but, actually, I think both of your subroutines are broken.)

    There are a number of things in that first sub that I would do differently, just to make it easier to maintain, and it would be good to generalize the method to any number of directories in a related set (not just 3 hard-coded items). So the first sub is not a good approach, and you need to refactor it into something more "structured" (that's a technical term in programming, and it refers to reducing code to a minimal set of distinct, modular components that can be re-used, as opposed to copying the same block of code repeatedly, with slight variations, in order to repeat a task on a series of slightly different cases).

    As for the second version (who was it that you got this from? and did you not credit that monk because s/he didn't want to be mentioned, or because you just forgot?), I think the problem is actually here:

    while ($_ = (readdir DIR)) { # print $_, "\n"; if (-d $_) { print "This is a dir $_ \n"; ...
    That should probably be something like this:
    while ($_ = (readdir DIR)) { # print $_, "\n"; if (-d "$input_directory_B/$_") { print "This is a dir $_ \n"; ....
    The point is that "opendir/readdir" does not accomplish a "chdir": in order to actually use a file name returned by readdir, you have to include the directory path that you gave to the opendir call (unless you did opendir D, '.'; ).

    Getting back to what I was saying about the first sub, you repeat the following sort of nonsense three times (I'm paraphrasing some of the names for brevity and generality):

    opendir (DIR, "$dirname") or die "Error opening directory: $!"; foreach (sort grep(/^Flat_file.*\.txt$/,readdir(DIR))) { push @list,$_; } @sorted_list = sort { -M $a <=> -M $b } @list; closedir DIR;
    You don't need to sort twice. You don't need to use "push" inside a foreach loop. Oh, and this actually seems to have the same problem as the second sub, in terms of not using "$dirname/$filename" -- you just weren't checking for errors, so you couldn't tell that all those "-M" calls were all failing, and the second sort wasn't really sorting files based on their age. (Maybe they just happened to have been stored in / read from the directory in chronological order, by coincidence?)

    You can do it this way instead -- note that readdir returns a list, which is input to the grep function, and likewise grep returns a list, which is input to the sort function, and likewise sort returns a list, which is assigned to the @sorted_list array (also, the error message for dying on a failed opendir call is a little more informative than the OP version):

    opendir( DIR, $dirname ) or die "opendir failed on $dirname: $!"; @sorted_list = sort { -M "$dirname/$a" <=> -M "$dirname/$b" } grep /^Flat_file.*\.txt$/, readdir(DIR) closedir DIR;
    Now, you could just take those few lines of code, and put them in a sub that returns the contents of the sorted list -- e.g.:
    sub getFileList { my ( $dir ) = @_; opendir( DIR, $dir ) or die "opendir failed on $dir: $!"; my @list = sort { -M "$dir/$a" <=> -M "$dir/$b" } grep /Flat_file.*\.txt$/, readdir DIR; closedir DIR; return @list; }
    Then, in your "Priorities_request" sub, just call this "getFileList" sub once for each directory name (whether the list of directory names is hard-coded, like in your original, or derived from another readdir operation, as in the second approach):
    sub Priorities_request { my ( $target_dir, $source_pattern, $node ) = @_; # the possible input directories should be in the current # working directory ("."), so let's read that first: opendir( CWD, "." ) or die "Damn! can't even opendir '.': $!"; my @dirs = grep m{\Q$source_pattern\E\d+}, readdir CWD; closedir CWD; my %dirlist; # hash of arrays, keyed by dir name for my $dir ( @dirs ) { @{$dirlist{$dir}} = getFileList( $dir ); } # now, each directory name that matched /$source_patten\d/ # is a key in the %dirlist hash, and the hash value for each # key is an array of file names matching "Flat_file*.txt", # sorted by date (oldest files first) # next, go through the directory names in reverse order # (highest to lowest) to move files as needed: for my $dir ( sort {$b cmp $a} keys %dirlist ) { for my $file ( @{$dirlist{$dir}} ) { if ( file_is_mine( $node, "$dir/$file" ) and do_it_now( $f +ile )) { rename "$dir/$file", "$target_dir/$file" or die "rename failed: $dir/$file -> $target_dir: $ +!" } } } }
    (passed "perl -cw" but not tested -- if you try it and find problems, try to fix them yourself before asking me for help.)

    Note that I'm suggesting some name changes for those two extra subroutine calls, "file_is_mine" and "do_it_now". Also, I'm assuming that when you used "move", you meant "rename".

    Doesn't that seem better than repeating blocks of code over and over for every directory and every file list? Isn't it nicer to write a block of code just once?

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://599910]
Approved by polettix
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having an uproarious good time at the Monastery: (6)
As of 2024-03-28 12:10 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found