myfolder1.cat % ls myfolder1 myfolder1.cat Where myfolder1.cat has all the contents of myfolder1, except that all occurrences of "dog" in any of the files have been replaced with "cat". My problem has been generating the new folder structure at the cwd. Has anyone seen this done before? I know mostly how to use File::Find, but it gets sticky because it doesn't provide a relative pathname for each new file to the original path supplied. There's got to be an easier way than what I'm doing (see below). It's main problem right now is that it doesn't work if the user happens to supply a starting folder like "myfolder1/mysubfolder1". Any tips would be much appreciated. - Bryan ************************************** [stuff cut out] # get temporary destination (to ease replace process using File::Find) and create $tdest = cwd() . "/temp.qns/"; mkdir($tdest,0777) or die "qns: Error 503: Cannot create directory $tdest: $!"; # grind through the original folder structure, build structure and do replacements find(\&process_file, ($source)); # move items to their final destination rename($tdest.$source,$fdest) or die "qns: Error 504: Can't move $tdest$source to $fdest: $!"; rmdir("temp.qns") or die "qns: Error 505: Couldn't remove temp directory temp.qns: $!"; [more stuff cut out] # --- subroutines ------------------------------------------------------- sub process_file { $thisdest = $tdest . $File::Find::name; # if the file is a directory, create corresponding structure in new folder if (-d) { mkdir($thisdest,0777) or die "qns: Error 601: Cannot create directory $thisdest: $!"; } # otherwise, process else { # read in file open(FILE, $_) or die "qns: Error 602: Couldn't open $File::Find::name: $!\n"; undef $/; $_ = ; close(FILE); # make replacements s/$s1/qq(qq($s2))/gmee; # write out file to new location open(OFILE, "> $thisdest") or die "qns: Error 603: Couldn't open $thisdest: $!\n"; print OFILE; close(OFILE); } } [allowsmilie] => 1 [showsignature] => 0 [ipaddress] => [iconid] => 0 [visible] => 1 [attach] => 0 [infraction] => 0 [reportthreadid] => 0 [isusenetpost] => 1 [msgid] => [ref] => [htmlstate] => on_nl2br [postusername] => Bryan [ip] => harrisb@dakotac [isdeleted] => 0 [usergroupid] => [membergroupids] => [displaygroupid] => [password] => [passworddate] => [email] => [styleid] => [parentemail] => [homepage] => [icq] => [aim] => [yahoo] => [msn] => [skype] => [showvbcode] => [showbirthday] => [usertitle] => [customtitle] => [joindate] => [daysprune] => [lastvisit] => [lastactivity] => [lastpost] => [lastpostid] => [posts] => [reputation] => [reputationlevelid] => [timezoneoffset] => [pmpopup] => [avatarid] => [avatarrevision] => [profilepicrevision] => [sigpicrevision] => [options] => [akvbghsfs_optionsfield] => [birthday] => [birthday_search] => [maxposts] => [startofweek] => [referrerid] => [languageid] => [emailstamp] => [threadedmode] => [autosubscribe] => [pmtotal] => [pmunread] => [salt] => [ipoints] => [infractions] => [warnings] => [infractiongroupids] => [infractiongroupid] => [adminoptions] => [profilevisits] => [friendcount] => [friendreqcount] => [vmunreadcount] => [vmmoderatedcount] => [socgroupinvitecount] => [socgroupreqcount] => [pcunreadcount] => [pcmoderatedcount] => [gmmoderatedcount] => [assetposthash] => [fbuserid] => [fbjoindate] => [fbname] => [logintype] => [fbaccesstoken] => [newrepcount] => [vbseo_likes_in] => [vbseo_likes_out] => [vbseo_likes_unread] => [temp] => [field1] => [field2] => [field3] => [field4] => [field5] => [subfolders] => [pmfolders] => [buddylist] => [ignorelist] => [signature] => [searchprefs] => [rank] => [icontitle] => [iconpath] => [avatarpath] => [hascustomavatar] => 0 [avatardateline] => [avwidth] => [avheight] => [edit_userid] => [edit_username] => [edit_dateline] => [edit_reason] => [hashistory] => [pagetext_html] => [hasimages] => [signatureparsed] => [sighasimages] => [sigpic] => [sigpicdateline] => [sigpicwidth] => [sigpicheight] => [postcount] => 1 [islastshown] => [isfirstshown] => 1 [attachments] => [allattachments] => ) --> myfolder1.cat > % ls > myfolder1 myfolder1.cat > > Where myfolder1.cat has all the contents of myfolder1, except that all > occurrences of "dog" in any of the files have been replaced with "cat". > > My problem has been generating the new folder structure at the cwd. Has > anyone seen this done before? I know mostly how to use File::Find, but it > gets sticky because it doesn't provide a relative pathname for each new file > to the original path supplied. There's got to be an easier way than what > I'm doing (see below). It's main problem right now is that it doesn't work > if the user happens to supply a starting folder like > "myfolder1/mysubfolder1".[/ref] Hi Bryan. Take a look at Path::Class to manipulate relative paths and File::Path to create complete paths if the don't exist. The code below creates a new absolute path for the source and destination directories and then, within File::Find's Wanted routine, calculates the contents of $File::Find::name relative to the source directory and then absolutely within the destination directory. The result is the full path to the new file. I've put code in to create the new path, but nothing to edit the files. All you need to do is open $file for reading and $copy for writing. HTH, Rob use strict; use warnings; use File::Find; use Path::Class; use File::Path qw/mkpath/; my $from = Path::Class::Dir->new('myfolder1')->absolute; my $dest = Path::Class::Dir->new('myfolder1.cat')->absolute; find(\&process, $from); sub process { my $file = Path::Class::File->new($File::Find::name); my $copy = $file->relative($from)->absolute($dest); print $copy, "\n"; my $newpath = $copy->dir; mkpath "$newpath"; # # stuff to copy the files # } [allowsmilie] => 1 [showsignature] => 0 [ipaddress] => [iconid] => 0 [visible] => 1 [attach] => 0 [infraction] => 0 [reportthreadid] => 0 [isusenetpost] => 1 [msgid] => <20040426140240.43465.qmail@onion.perl.org> [ref] => [htmlstate] => on_nl2br [postusername] => Rob [ip] => rob@dixon.port9 [isdeleted] => 0 [usergroupid] => [membergroupids] => [displaygroupid] => [password] => [passworddate] => [email] => [styleid] => [parentemail] => [homepage] => [icq] => [aim] => [yahoo] => [msn] => [skype] => [showvbcode] => [showbirthday] => [usertitle] => [customtitle] => [joindate] => [daysprune] => [lastvisit] => [lastactivity] => [lastpost] => [lastpostid] => [posts] => [reputation] => [reputationlevelid] => [timezoneoffset] => [pmpopup] => [avatarid] => [avatarrevision] => [profilepicrevision] => [sigpicrevision] => [options] => [akvbghsfs_optionsfield] => [birthday] => [birthday_search] => [maxposts] => [startofweek] => [referrerid] => [languageid] => [emailstamp] => [threadedmode] => [autosubscribe] => [pmtotal] => [pmunread] => [salt] => [ipoints] => [infractions] => [warnings] => [infractiongroupids] => [infractiongroupid] => [adminoptions] => [profilevisits] => [friendcount] => [friendreqcount] => [vmunreadcount] => [vmmoderatedcount] => [socgroupinvitecount] => [socgroupreqcount] => [pcunreadcount] => [pcmoderatedcount] => [gmmoderatedcount] => [assetposthash] => [fbuserid] => [fbjoindate] => [fbname] => [logintype] => [fbaccesstoken] => [newrepcount] => [vbseo_likes_in] => [vbseo_likes_out] => [vbseo_likes_unread] => [temp] => [field1] => [field2] => [field3] => [field4] => [field5] => [subfolders] => [pmfolders] => [buddylist] => [ignorelist] => [signature] => [searchprefs] => [rank] => [icontitle] => [iconpath] => [avatarpath] => [hascustomavatar] => 0 [avatardateline] => [avwidth] => [avheight] => [edit_userid] => [edit_username] => [edit_dateline] => [edit_reason] => [hashistory] => [pagetext_html] => [hasimages] => [signatureparsed] => [sighasimages] => [sigpic] => [sigpicdateline] => [sigpicwidth] => [sigpicheight] => [postcount] => 2 [islastshown] => [isfirstshown] => [attachments] => [allattachments] => ) --> Process folder structure into new structure - PERL Beginners

Process folder structure into new structure - PERL Beginners

Hi, all, I need to process one folder structure into a new folder structure, e.g. replace the word "dog" with "cat" recursively down through a folder, writing the updated files into a new structure: % ls myfolder1 % dog2cat myfolder1 dog2cat: myfolder1 --> myfolder1.cat % ls myfolder1 myfolder1.cat Where myfolder1.cat has all the contents of myfolder1, except that all occurrences of "dog" in any of the files have been replaced with "cat". My problem has been generating the new folder structure at the cwd. Has anyone seen this done before? I know mostly how to use File::Find, but it gets ...

  1. #1

    Default Process folder structure into new structure



    Hi, all,

    I need to process one folder structure into a new folder structure, e.g.
    replace the word "dog" with "cat" recursively down through a folder, writing
    the updated files into a new structure:

    % ls
    myfolder1
    % dog2cat myfolder1
    dog2cat: myfolder1 --> myfolder1.cat
    % ls
    myfolder1 myfolder1.cat

    Where myfolder1.cat has all the contents of myfolder1, except that all
    occurrences of "dog" in any of the files have been replaced with "cat".

    My problem has been generating the new folder structure at the cwd. Has
    anyone seen this done before? I know mostly how to use File::Find, but it
    gets sticky because it doesn't provide a relative pathname for each new file
    to the original path supplied. There's got to be an easier way than what
    I'm doing (see below). It's main problem right now is that it doesn't work
    if the user happens to supply a starting folder like
    "myfolder1/mysubfolder1".

    Any tips would be much appreciated.

    - Bryan

    **************************************


    [stuff cut out]

    # get temporary destination (to ease replace process using File::Find)
    and create
    $tdest = cwd() . "/temp.qns/";
    mkdir($tdest,0777) or die "qns: Error 503: Cannot create directory
    $tdest: $!";

    # grind through the original folder structure, build structure and do
    replacements
    find(\&process_file, ($source));

    # move items to their final destination
    rename($tdest.$source,$fdest) or die "qns: Error 504: Can't move
    $tdest$source to $fdest: $!";
    rmdir("temp.qns") or die "qns: Error 505: Couldn't remove temp
    directory temp.qns: $!";

    [more stuff cut out]

    # --- subroutines -------------------------------------------------------

    sub process_file {

    $thisdest = $tdest . $File::Find::name;

    # if the file is a directory, create corresponding structure in new
    folder
    if (-d) { mkdir($thisdest,0777) or die "qns: Error 601: Cannot create
    directory $thisdest: $!"; }

    # otherwise, process
    else {

    # read in file
    open(FILE, $_) or die "qns: Error 602: Couldn't open
    $File::Find::name: $!\n";
    undef $/;
    $_ = <FILE>;
    close(FILE);

    # make replacements
    s/$s1/qq(qq($s2))/gmee;

    # write out file to new location
    open(OFILE, "> $thisdest") or die "qns: Error 603: Couldn't open
    $thisdest: $!\n";
    print OFILE;
    close(OFILE);
    }

    }


    Bryan Guest

  2. #2

    Default Re: Process folder structure into new structure

    Bryan Harris wrote: 

    Hi Bryan.

    Take a look at Path::Class to manipulate relative paths and File::Path to
    create complete paths if the don't exist. The code below creates a new
    absolute path for the source and destination directories and then, within
    File::Find's Wanted routine, calculates the contents of $File::Find::name
    relative to the source directory and then absolutely within the destination
    directory. The result is the full path to the new file.

    I've put code in to create the new path, but nothing to edit the files. All
    you need to do is open $file for reading and $copy for writing.

    HTH,

    Rob


    use strict;
    use warnings;

    use File::Find;
    use Path::Class;
    use File::Path qw/mkpath/;

    my $from = Path::Class::Dir->new('myfolder1')->absolute;
    my $dest = Path::Class::Dir->new('myfolder1.cat')->absolute;

    find(\&process, $from);

    sub process {

    my $file = Path::Class::File->new($File::Find::name);
    my $copy = $file->relative($from)->absolute($dest);

    print $copy, "\n";

    my $newpath = $copy->dir;
    mkpath "$newpath";

    #
    # stuff to copy the files
    #
    }



    Rob Guest

  3. #3

    Default Re: Process folder structure into new structure


     


    It does, Rob, thanks! This belongs on a "very helpful perl code" page
    somewhere.

    Thanks again. =)

    - Bryan


    Bryan Guest

  4. #4

    Default Re: Process folder structure into new structure

    On Mon, Apr 26, 2004 at 09:32:47PM -0700, Bryan Harris wrote: 
    I've begun one at http://www.kallisti.net.nz/PerlTips
    feel free to add it (it's a wiki).

    --
    Robin <net.nz> JabberID: <org>

    Hostes alienigeni me abduxerunt. Qui annus est?

    PGP Key 0x776DB663 Fingerprint=DD10 5C62 1E29 A385 9866 0853 CD38 E07A 776D B663

    -----BEGIN PGP SIGNATURE-----
    Version: GnuPG v1.2.4 (GNU/Linux)

    iD8DBQFAjeWQzTjgendttmMRApZTAJ4vWGGyfeCYfEsXD6im5y OCpvrvPQCgsrwC
    vwKOfxC558xkihKseJdfl8I=
    =8wDm
    -----END PGP SIGNATURE-----

    Robin Guest

Similar Threads

  1. DW: folder structure template
    By Dan Joyce in forum Macromedia Dynamic HTML
    Replies: 5
    Last Post: May 10th, 06:06 PM
  2. Replies: 1
    Last Post: May 1st, 03:24 PM
  3. Add to Structure
    By H3ath0r in forum Coldfusion - Getting Started
    Replies: 4
    Last Post: September 24th, 12:57 AM
  4. Copy & rename entire folder structure
    By skooter in forum Coldfusion - Advanced Techniques
    Replies: 2
    Last Post: February 17th, 05:12 PM
  5. W3D structure...
    By Glorfind3l in forum Macromedia Director 3D
    Replies: 2
    Last Post: February 26th, 10:00 PM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •