Here is my output directory structure: ``` . `-- Muska |-- Muska.config |-- Muska.html `-- Muska_Digital |-- Digital_Verification | |-- Digital_Verification.config | |-- Digital_Verification.html | `-- rev1 | |-- _projects_Muska_Muska_Digital_Digital_Verification +_rev1.config | `-- _projects_Muska_Muska_Digital_Digital_Verification +_rev1.html |-- Muska_Digital.config `-- Muska_Digital.html ``` Here under Digital_verification.html i will have the following content +s. ``` SL.NO CHECKLIST ITEM VALUE COMMENTS CONFIRMATION Revision1 100.00% 100.00% OVERALL_STATUS=100.00% PARTIAL_STATUS=100.00% ``` So now if i click Revision1 it should open the .html file inside the r +ev1 folder.The problem is because of names.Here the folder name varie +s.Is it possible to link even the folder has different names. My code which as follows: ``` #! /usr/local/bin/perl use strict; use warnings; use Data::Dumper; use File::Path qw( make_path ); use File::Copy qw( copy move); use File::Find::Rule qw( ); use Cwd qw(getcwd); use File::Basename; use File::Copy (); use File::Remove (); use File::Basename; use File::Find; use File::Spec; use Getopt::Long qw( GetOptions ); use Cwd; my $usage="./file.pl -prjroot=<location> -outdir=<location> -mapfile=< +location>"; print "Usage of the script:$usage \n"; ##TO CHECK THE USAGE AT COMMAND LINE ARGUMENTS## sub usage { if (@_) { my ($msg) = @_; chomp($msg); print(STDERR "$msg\n"); } my $prog = basename($0); print(STDERR "$prog --help for usage\n"); exit(1); } sub help { my $prog = basename($0); print(STDERR "$prog [options] -output output_dir\n"); print(STDERR "$prog --help\n"); exit(0); } ##GETTING INPUT/OUTPUT FILE FROM COMMAND LINE ARGUMENTS## GetOptions( 'help|h|?' => \&help, 'prjroot=s' => \my $base_dir, 'outdir=s' => \my $output_dir, 'mapfile=s' => \my $mapfile, ) or usage(); print "Directory created at destination location \n"; ##CREATING THE DIRECTORIES FROM COMMAND LINE ARGUMENTS## mkdir $output_dir ; my $input_dir = get_input_dir( $base_dir ); sub get_input_dir { my ( $base_dir ) = @_; my $fn = File::Spec->catfile( $base_dir, 'project.config' ); my $input_dir; open ( my $fh, '<', $fn ) or die "Could not open file '$fn': $!"; while ( <$fh> ) { chomp; if (/^REVISION_LOCATION:\s*(\S+)/) { $input_dir = $1; last; } } close $fh; die "Could not find revision location!" if !defined $input_dir; return $input_dir; } my @input_dirs = ( $input_dir ); if ( $input_dir =~ /^\.\./ ) { @input_dirs = find_input_dirs( $input_dir ); } sub find_input_dirs { my ( $dir ) = @_; $dir =~ s/^\.\.//; my @dirs = File::Find::Rule->new->directory ->exec( sub { ($_[1] =~ /\Q$dir\E/) ? 1 : 0 } )->in('/'); return @dirs; } for my $input_dir ( @input_dirs ) { #print $input_dir; copy_config_files( $input_dir, $output_dir ); } sub copy_config_files { my ( $input_dir, $output_dir ) = @_; } ##COPYING THE CONFIG FILES FROM SOURCE TO DESTINATION### print"Copying config files from source to destination \n"; my %created; for my $in ( File::Find::Rule ->maxdepth(5) ->file() ->prune() ->name(qr/^[^.].*\.config$/) ->in($input_dir) ) { my $match_file = substr($in, length($input_dir) + 1); # print "***$match_file***"; my ($match_dir) = $match_file =~ m{^(.*)/} ? $1 : '.'; my $out_dir = $output_dir . '/' . $match_dir; my $out = $output_dir . '/' . $match_file; make_path($out_dir) if !$created{$out_dir}++; copy($in, $out); } print "Renaming the folders and sub folders names at destination fold +er \n"; ##TO RENAME DIRECTORIES AND RENAME THE CONTENTS OF THE .CONFIG FILES A +S PER MATCHING WITH MAPFILE.TXT CONTENTS## my $name_map = read_map( $mapfile ); my ($regex) = map {qr /\b(?:$_)\b/ } join '|', map {quotemeta} keys %$ +name_map; my $top_dir = $output_dir; rename_dirs( $top_dir, $name_map, $regex ); sub rename_dirs { my ( $top_dir, $name_map, $regex ) = @_; opendir (my $dh, $top_dir) or die "Can't open $top_dir: $!"; my $save_dir = getcwd(); chdir $top_dir; while (my $name = readdir $dh) { next if ($name eq '.') or ($name eq '..'); if ( ( -d $name ) && ( exists $name_map->{$name} ) ) { my $new_name = $name_map->{$name}; rename_file_or_dir( $name, $new_name ); $name = $new_name; } elsif ( -f $name ) { when_config_file_rename_and_modify_it( $name, $name_map, $ +regex ); } else { #print " --> is not a directory", "\n"; } if ( -d $name) { rename_dirs( $name, $name_map, $regex ); } } chdir $save_dir; } sub when_config_file_rename_and_modify_it { my ( $name, $name_map, $regex ) = @_; if (( my $base_name = $name) =~ s/\.config$// ) { if ( $name_map->{$base_name} ) { my $new_name = $name_map->{$base_name} . '.config'; rename_file_or_dir( $name, $new_name ); $name = $new_name; } change_file( $name, $name_map, $regex ); } } sub change_file { my ( $fn, $map, $regex ) = @_; open ( my $fh, '<', $fn ) or die "Could not open file '$fn': $!"; my $str = do { local $/; <$fh> }; close $fh; my $num_replacements = $str =~ s/($regex)/$map->{$1}/ge; if ( $num_replacements ) { write_new_file( $fn, \$str ); } } sub write_new_file { my ( $fn, $str ) = @_; open ( my $fh, '>', $fn ) or die "Could not open file '$fn': $!"; print $fh $$str; close $fh; } sub rename_file_or_dir { my ( $name, $new_name ) = @_; File::Copy::move( $name, $new_name ) or die "Could not rename '$name' as '$new_name': $!"; #print $name; } print "Mapping the file to rename the directories from source locatio +n \n"; sub read_map { my ( $fn ) = @_; my %name_map; open( my $fh, '<', $fn ) or die "Could not open file '$fn': $!"; while( my $line = <$fh> ) { chomp $line; my @fields = split /:/, $line; # print @fields; if ( @fields == 3 ) { $name_map{$fields[2]} = $fields[1]; } } close $fh; return \%name_map; } print "Renaming the files with its directory names \n"; ##RENAME THE FILES WITH ITS DIRECTORIES NAME FROM THE FOLDERS NAME## my $input_file_dir = $output_dir; sub process_file { my $dir_name = (File::Spec -> splitdir ($File::Find::dir))[-1]; my $file_name = basename $_; my $extension = ($file_name =~ m/([^.]+)$/)[0]; if ( -f $_ ) { rename $_, "$dir_name.$extension"; } } finddepth { 'wanted' => \&process_file, 'no_chdir' => 0 }, $input_ +file_dir; ##PROCESSING AND REMOVING THE UNWANTED DIRECTORIES## sub ProcessDirectory{ my ($workdir) = shift; my $mask = $workdir . '/*'; my @dirs = grep { -d } glob $mask; foreach my $d (@dirs) { ProcessDirectory($d); my $dirname = basename($d); if ($dirname =~ /^temp*/) { my $filemask = $d . '/*'; unlink glob $filemask; rmdir $d; } } } ProcessDirectory($output_dir); ##REMOVE TASK.CONFIG FROM ALL DIRECTORIES## sub DelTaskFiles{ my ($workdir) = shift; my $mask = $workdir . '/*'; my @files1 = glob $mask; foreach my $f (@files1) { if(-d $f) { DelTaskFiles($f); } else { my $filename1 = basename($f); if ($filename1 =~ /^task*/) { unlink $filename1; } } } } DelTaskFiles($output_dir); print "Renaming the .html files as perl the directory location link \n +"; ###RENAMING THE FILES sub run_dir { my ($prefix, $dir, $dir_base_name) = @_; opendir (my $dh, $dir) or die "Could not open dir '$dir': $!"; my @entries = readdir $dh; closedir $dh; for my $name (@entries) { next if $name =~ /^\.\.?\z/; my $pathname = File::Spec->catfile( $dir, $name ); if ( -d $pathname ) { (my $new_prefix = $dir) =~ s{/}{_}g; run_dir( $new_prefix . '_', $pathname, $name); } elsif ( ( -f $pathname ) && ($dir_base_name =~ /^rev/) ) { if ( ( $name =~ /\.config\z/ ) && ($name !~ /^\Q$prefix\E/ +) ) { my $new_name = File::Spec->catfile( $dir, $prefix . $n +ame ); rename $pathname, $new_name or die "Could not rename '$pathname' as '$new_name': + $!"; } } } } run_dir('', $output_dir, $output_dir); ##########MAXIMUM FILE FILTER =d my $location = $output_dir; print $location; open LOGFILE, $location; my $first_line = 1; print $first_line; my $max_id; while (<LOGFILE>) { if (/rev(\d+)/) { if ($first_line) { $first_line = 0; $max_id = $1; print $max_id; } else { $max_id = $1 if ($1 > $max_id); print $max_id; } } } close LOGFILE; =cut sub file_filter { my $location=shift; open LOGFILE, $location; my $max_id; while (<LOGFILE>) { if (/rev(\d+)/) { $max_id = $1; } else { $max_id = $1 if ($1 > $max_id); } } close LOGFILE; } file_filter($output_dir); =d sub scan_handle_for_rev { my $filehandle = shift; my $first_line = 1; my $max_id; while (<$filehandle>) { if (/rev(\d+)/) { if ($first_line) { $first_line = 0; $max_id = $1; } else { $max_id = $1 if ($1 > $max_id); } } } return $max_id; } scan_handle_for_rev($output_dir); =cut print"Converting the .config files to .html files at destination locat +ion \n"; ##HTML CONVERSION## my @files = File::Find::Rule->file ->name('*.config') ->prune ->in($output_dir); + foreach my $file (@files) { my ($name, $root, $ext) = $file =~ m|(.*)/(.*)\.(.*)|; my $outfile = "$name/$root.html"; # print $outfile; open my $fh_out, '>', $outfile or die "Can't open $outfile: $!","\ +n"; my $head = " <!doctype html> <html lang=\"en\"> <head> <meta charset=\"utf-8\"> <title>DCMS_CHECKLIST</title><tr><td>< +/td></tr> </head> <body> <table> <th>SL.NO</th><th>CHECKLIST ITEM</th><th>VALUE</th><th>COMMENTS</th><t +h>CONFIRMATION</th> <style> .bold { font-weight: bold; } .bold td { border: 0px; } table, th, td { border: 1px solid black; } </style>"; print $fh_out $head ; # write the header open my $fh, '<', $file or die "Can't open $file: $!"; while (my $line=<$fh>) { chomp $line; for($line) { s/\&//g; s/COMMENT//g; } my @data = split /:/, $line; my $class = $data[0] ? 'normal' : 'bold'; print $fh_out qq[<tr class="$class">]; my $check=0; my $dolink=$data[0] !~ m/[\=\%]/; for my $word(@data){ $check++; print $fh_out '<td>'; if($check==1 && $dolink ) { $word=~s/("\S+|\S+|")\s*/$1/g; print $fh_out qq[<a href="$word/$word.html">$word</a>]; } else { print $fh_out $word;} print $fh_out '</td>'; } } } ```
Ok, here is a suggestion. I consider the if block: if ($check==1 && $dolink ) { ($word, $link ) = get_html_link_info( $name, $word ); print $fh_out qq[<a href="$link">$word</a>]; } now I added the get_html_link_info() function: sub get_html_link_info { my ( $dir, $word ) = @_; $word=~s/(\S+)\s*/$1/g; my @dirs = <$dir/rev*>; my $num_dirs = scalar @dirs; if ( $num_dirs != 1) { die "Unexpected directory configuration. Expected single rev* +folder, " . "found $num_dirs folder(s)"; } $dir = shift @dirs; my @files = <$dir/*.html>; my $num_files = scalar @files; if ( $num_files != 1) { die "Unexpected directory configuration. Expected single .html + file, " . "found $num_files .html files(s)"; } my $link = shift @files; return ($word, $link ) }
In reply to Finally linking issues using perl by gpssana
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |