How to grep string and assign it to a variable in Perl - perl

I have a file with the below details;
file name: allappsclus
cont:i-02dd208bf1d81c254
rs:i-0098ad0b59b7fe7cf
I want to use the value for i-XXX"= in associated cont name and assign it to another variable.
If run my code and get an output it is
test-1.1.0.0
1insideif-CNS
use strict;
use warnings;
use Data::Dumper;
my $jupyter = 0;
my $controller = 0;
my $rstudio = 0;
my $zeppelin = 0;
my $fh= '/tmp/allappsclus';
open my $fh2, '<', $fh or die "Cannot open file: $!\n";
while ( <$fh2> ) {
if ( $_ =~ /jup/ ) {
$jupyter = 1;
}
elsif ( $_ =~ /con/ ) {
$controller = 1;
}
elsif ( $_ =~ /rs/ ) {
$rstudio = 1;
}
elsif ( $_ =~ /zep/ ) {
$zeppelin = 1;
}
}
print "test-$rs.$con.$jup.$zep\n";
if ( $zepeq '0' && $jup eq '0' && $con eq '1' && $rs eq '1' ) {
print "insideif-CNS";
}
else {
print "do nothing";
}
close $fh;
close $fh2;
Now I want to print the value i-02dd208bf1d81c254 instead of CNS in the output.

$myStr = "cont:i-02dd208bf1d81c254 rs:i-0098ad0b59b7fe7cf";
if ($myStr =~ /cont:([^ ]+)/) # match the full pattern with the value you required
{
$controller=1;
$cont = $1; # assign required value to a variable
}
print $cont; # print the variable
This might work for you.

Related

Unable to retrieve multiple column values from file in Perl

I have a file with following contents:
TIME
DATE TIME DAY
191227 055526 FRI
RC DEV SERVER
RC1 SERVER1
RC2 SERVER2
RC3 SERVER3
END
I am fetching argument values from this file, say if I pass DATE as an argument to the script I am getting corresponding value of the DATE. i.e., 191227
When I pass multiple arguments say DATE, DAY I should get values:
DATE=191227
DAY=FRI
But what I am getting here is:
DATE=191227
DAY=NULL
And if I pass RC as an argument I should get:
RC=RC1,RC2,RC3
The script looks below:
#!/usr/bin/perl
use strict;
use Data::Dumper;
print Dumper(\#ARGV);
foreach my $name(#ARGV){
print "NAME:$name\n";
my ($result, $start, $stop, $width) = "";
while(my $head = <STDIN>)
{
if( $head =~ (m/\b$name\b/g))
{
$start = (pos $head) - length($name);
$stop = (pos $head);
my $line = <STDIN>;
pos $head = $stop+1;
$head =~ (m/\b/g);
$width = (pos $head) - $start;
$result = substr($line,$start,$width);
}
}
$result =~ s/^\s*(.*?)\s*$/$1/;
print "$name=";
$result = "NULL" if ( $result eq "" );
print "$result\n";
}
Can someone please help me to get values if I pass multiple arguments also if suppose argument value have data in multiple lines it should be printed comma separated values (ex: for RC, RC=RC1,RC2,RC3).
Here is an example, assuming the input file is named file.txt and the values are starting at the same horizontal position as the keys:
package Main;
use feature qw(say);
use strict;
use warnings;
use Data::Dumper qw(Dumper);
my $self = Main->new(fn => 'file.txt', params => [#ARGV]);
$self->read_file();
$self->print_values();
sub read_file {
my ( $self ) = #_;
my $fn = $self->{fn};
open ( my $fh, '<', $fn ) or die "Could not open file '$fn': $!";
local $/ = ""; #Paragraph mode
my #blocks = <$fh>;
close $fh;
$self->{values} = {};
for my $block (#blocks) {
$self->parse_block( $block );
}
}
sub parse_block {
my ( $self, $block ) = #_;
my #lines = split /\n/, $block;
my $header = shift #lines;
my ($keys, $startpos) = $self->get_block_keys( $header );
for my $line ( #lines ) {
for my $key (#$keys) {
my $startpos = $startpos->{$key};
my $str = substr $line, $startpos;
my ( $value ) = $str =~ /^(\S+)/;
if ( defined $value ) {
push #{$self->{values}{$key}}, $value;
}
}
}
}
sub get_block_keys {
my ( $self, $header ) = #_;
my $values = $self->{values};
my #keys;
my %spos;
while ($header =~ /(\S+)/g) {
my $key = $1;
my $startpos = $-[1];
$spos{$key} = $startpos;
push #keys, $key;
}
for my $key (#keys) {
if ( !(exists $values->{$key}) ) {
$values->{$key} = [];
}
}
return (\#keys, \%spos);
}
sub new {
my ( $class, %args ) = #_;
return bless \%args, $class;
}
sub print_values {
my ( $self ) = #_;
my $values = $self->{values};
for my $key (#{$self->{params}}) {
my $value = "<NO VALUE FOUND>";
if ( exists $values->{$key} ) {
$value = join ",", #{$values->{$key}};
}
say "$key=$value";
}
}
Edit
If you want to read the file from STDIN instead, change the following part of the code:
# [...]
my $self = Main->new(params => [#ARGV]);
$self->read_file();
$self->print_values();
sub read_file {
my ( $self ) = #_;
local $/ = ""; #Paragraph mode
my #blocks = <STDIN>;
$self->{values} = {};
for my $block (#blocks) {
$self->parse_block( $block );
}
}
# [...]

Perl output format

I'm reading a log file and grouping it based on the 'Program' name and in turn its ID.
LOG FILE
------------------------------------------
DEV: COM-1258
Program:Testing
Reviewer:Jackie
Description:New Entries
rev:r145201
------------------------------------------
QA: COM-9696
Program:Testing
Reviewer:Poikla
Description:Some random changes
rev:r112356
------------------------------------------
JIRA: COM-1234
Program:Development
Reviewer:John Wick
Description:Genral fix
rev:r345676
------------------------------------------
JIRA:COM-1234
Program:Development
Reviewer:None
Description:Updating Received
rev:r909276
------------------------------------------
JIRA: COM-6789
Program:Testing
Reviewer:Balise Mat
Description:Audited
rev:r876391
------------------------------------------
JIRA: COM-8585
Program:Testing
Reviewer:Gold frt
Description: yet to be reviewed
rev:r565639
The code I have,
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Terse = 1;
my $file = "log.txt";
open FH, $file or die "Couldn't open file: [$!]\n";
my $data = {};
my $hash = {};
while (<FH>)
{
my $line = $_;
chomp $line;
if ($line =~ m/(-){2,}/)
{
my $program = $hash->{Program} || '';
my $jira = $hash->{JIRA} || $hash->{QA} || $hash->{DEV} ||
+'';
if ($program && $jira)
{
push #{$data->{$program}{$jira}}, $hash;
$hash = {};
}
}
else
{
if ($line =~ m/:/)
{
my ($key, $value) = split /:\s*/, $line;
$hash->{$key} = $value;
}
elsif ($line =~ m#/# && exists $hash->{Files})
{
$hash->{Files} .= "\n$line";
}
}
}
print 'data = ' . Dumper($data);
foreach my $prg (sort keys %{$data})
{
print "===========================================================
+=\n";
print " PROGRAM : $prg
+ \n";
print "===========================================================
+=\n";
foreach my $jira (sort keys %{$data->{$prg}})
{
print "******************\n";
print "JIRA ID : $jira\n";
print "******************\n";
foreach my $hash (#{$data->{$prg}{$jira}})
{
foreach my $key (keys %{$hash})
{
# print the data except Program and JIRA
next if $key =~ m/(Program|JIRA|DEV|QA)/;
print " $key => $hash->{$key}\n";
}
print "\n";
}
}
}
I have a requirement to print the output in the below format and currently unable to do so with my logic, any ideas would be really helpful.
PROGRAM: Development
Change IDs:
1.JIRA
a.COM-1234
PROGRAM: Testing
Change IDs:
1.JIRA
a.COM-6789
b.COM-8585
2.QA
a.COM-9696
3.DEV
a.COM-1258
I would write this
use strict;
use warnings 'all';
use List::Util 'uniq';
my $file = 'log.txt';
open my $fh, $file or die "Couldn't open file: [$!]\n";
my #data;
{
my %item;
while ( <$fh> ) {
chomp;
if ( eof or /\-{2,}/ ) {
push #data, { %item } if keys %item;
%item = ();
}
else {
my ( $key, $value ) = split /\s*:\s*/;
next unless $value;
$item{$key} = $value;
$item{jira} = $key if grep { $key eq $_ } qw/ JIRA DEV QA /;
}
}
}
my %data;
{
for my $item ( #data ) {
my ($prog, $jira) = #{$item}{qw/ Program jira /};
push #{ $data{$prog}{$jira} }, $item->{$jira};
}
}
for my $prog ( sort keys %data ) {
printf "PROGRAM: %s\n", $prog;
print "Change IDs:\n";
my $n = 1;
for my $jira ( qw/ JIRA QA DEV / ) {
next unless my $codes = $data{$prog}{$jira};
printf "%d.%s\n", $n++, $jira;
my $l = 'a';
printf " %s.%s\n", $l++, $_ for sort(uniq(#$codes));
}
print "\n";
}
output
PROGRAM: Development
Change IDs:
1.JIRA
a.COM-1234
PROGRAM: Testing
Change IDs:
1.JIRA
a.COM-6789
b.COM-8585
2.QA
a.COM-9696
3.DEV
a.COM-1258
#!/usr/bin/perl -w
use strict;
use warnings;
use Data::Dumper;
my $file = 'test';
my $hash;
my $id_hash = ();
my $line_found = 0;
my $line_count = 1;
my $ID;
my $ID_num;
open (my $FH, '<', "$file") or warn $!;
while (my $line = <$FH> ) {
chomp($line);
if ( $line =~ m/------------------------------------------/){
$line_found = 1;
$line_count++;
next;
}
if ( $line_found ) {
$line =~ m/(.*?):(.*)/;
$ID = $1;
$ID_num = $2;
$line_found = 0;
}
if ( $line =~ m/Program:(.*)/ ) {
my $pro = $1;
push #{$hash->{$pro}->{$ID}}, ($ID_num) ;
}
$line_count++;
}
close $FH;
foreach my $pro (keys %$hash){
# print Dumper($pro);
print "PROGRAM:\t$pro\nChange IDs:\n";
foreach my $ids (keys $hash->{$pro}){
print "\t1. $ids\n";
foreach my $id (values $hash->{$pro}->{$ids}){
print "\t\ta. $id\n";
}
}
}
OUTPUT
PROGRAM: Testing
Change IDs:
1. QA
a. COM-9696
1. DEV
a. COM-1258
1. JIRA
a. COM-6789
a. COM-8585
PROGRAM: Development
Change IDs:
1. JIRA
a. COM-1234
a. COM-1234
Just change the output to your need!!

"No such file" when opening multiple files in a directory, but no error when opening only one file

I can open one file in a directory and run the following code. However, when I try to use the same code on multiple files within a directory, I get an error regarding there not being a file.
I have tried to make sure that I am naming the files correctly, that they are in the right format, that they are located in my current working directory, and that things are referenced correctly.
I know a lot of people have had this error before and have posted similar questions, but any help would be appreciated.
Working code:
#!/usr/bin/perl
use warnings;
use strict;
use diagnostics;
use List::Util qw( min max );
my $RawSequence = loadSequence("LDTest.fasta");
my $windowSize = 38;
my $stepSize = 1;
my %hash;
my $s1;
my $s2;
my $dist;
for ( my $windowStart = 0; $windowStart <= 140; $windowStart += $stepSize ) {
my $s1 = substr( $$RawSequence, $windowStart, $windowSize );
my $s2 = 'CGGAGCTTTACGAGCCGTAGCCCAAACAGTTAATGTAG';
# the 28 nt forward primer after the barcode plus the first 10 nt of the mtDNA dequence
my $dist = levdist( $s1, $s2 );
$hash{$dist} = $s1;
#print "Distance between '$s1' and '$s2' is $dist\n";
sub levdist {
my ( $seq1, $seq2 ) = (#_)[ 0, 1 ];
my $l1 = length($s1);
my $l2 = length($s2);
my #s1 = split '', $seq1;
my #s2 = split '', $seq2;
my $distances;
for ( my $i = 0; $i <= $l1; $i++ ) {
$distances->[$i]->[0] = $i;
}
for ( my $j = 0; $j <= $l2; $j++ ) {
$distances->[0]->[$j] = $j;
}
for ( my $i = 1; $i <= $l1; $i++ ) {
for ( my $j = 1; $j <= $l2; $j++ ) {
my $cost;
if ( $s1[ $i - 1 ] eq $s2[ $j - 1 ] ) {
$cost = 0;
}
else {
$cost = 1;
}
$distances->[$i]->[$j] = minimum(
$distances->[ $i - 1 ]->[ $j - 1 ] + $cost,
$distances->[$i]->[ $j - 1 ] + 1,
$distances->[ $i - 1 ]->[$j] + 1,
);
}
}
my $min_distance = $distances->[$l1]->[$l2];
for ( my $i = 0; $i <= $l1; $i++ ) {
$min_distance = minimum( $min_distance, $distances->[$i]->[$l2] );
}
for ( my $j = 0; $j <= $l2; $j++ ) {
$min_distance = minimum( $min_distance, $distances->[$l1]->[$j] );
}
return $min_distance;
}
}
sub minimum {
my $min = shift #_;
foreach (#_) {
if ( $_ < $min ) {
$min = $_;
}
}
return $min;
}
sub loadSequence {
my ($sequenceFile) = #_;
my $sequence = "";
unless ( open( FASTA, "<", $sequenceFile ) ) {
die $!;
}
while (<FASTA>) {
my $line = $_;
chomp($line);
if ( $line !~ /^>/ ) {
$sequence .= $line; #if the line doesn't start with > it is the sequence
}
}
return \$sequence;
}
my #keys = sort { $a <=> $b } keys %hash;
my $BestMatch = $hash{ keys [0] };
if ( $keys[0] < 8 ) {
$$RawSequence =~ s/\Q$BestMatch\E/CGGAGCTTTACGAGCCGTAGCCCAAACAGTTAATGTAG/g;
print ">|Forward|Distance_of_Best_Match: $keys[0] |Sequence_of_Best_Match: $BestMatch", "\n",
"$$RawSequence", "\n";
}
Here is an abbreviated version of my non-working code. Things that haven't changed I didn't included:
Headers and Globals:
my $dir = ("/Users/roblogan/Documents/FakeFastaFiles");
my #ArrayofFiles = glob "$dir/*.fasta";
foreach my $file ( #ArrayofFiles ) {
open( my $Opened, $file ) or die "can't open file: $!";
while ( my $OpenedFile = <$Opened> ) {
my $RawSequence = loadSequence($OpenedFile);
for ( ... ) {
...;
print
">|Forward|Distance_of_Best_Match: $keys[0] |Sequence_of_Best_Match: $BestMatch",
"\n", "$$RawSequence", "\n";
}
}
}
The exact error is:
Uncaught exception from user code:
No such file or directory at ./levenshtein_for_directory.pl line 93, <$Opened> line 1.
main::loadSequence('{\rtf1\ansi\ansicpg1252\cocoartf1404\cocoasubrtf470\x{a}') called at ./levenshtein_for_directory.pl line 22
line 93:
89 sub loadSequence{
90 my ($sequenceFile) = #_;
91 my $sequence = "";
92 unless (open(FASTA, "<", $sequenceFile)){
93 die $!;
94 }
Line 22:
18 foreach my $file ( #ArrayofFiles ) {
19 open (my $Opened, $file) or die "can't open file: $!";
20 while (my $OpenedFile = <$Opened>) {
21
22 my $RawSequence = loadSequence($OpenedFile);
23
I just learned that "FASTA file" is a settled term. Wasn't aware of that and previously thought they are some files and contain filenames or something. As #zdim already said, you're opening these files twice.
The following code gets a list of FASTA files (only the filenames) and then calls loadSequence with each such a filename. That subroutine then opens the given file, concatenates the none-^> lines to one big line and returns it.
# input: the NAME of a FASTA file
# return: all sequences in that file as one very long string
sub loadSequence
{
my ($fasta_filename) = #_;
my $sequence = "";
open( my $fasta_fh, '<', $fasta_filename ) or die "Cannot open $fasta_filename: $!\n";
while ( my $line = <$fasta_fh> ) {
chomp($line);
if ( $line !~ /^>/ ) {
$sequence .= $line; #if the line doesn't start with > it is the sequence
}
}
close($fasta_fh);
return $sequence;
}
# ...
my $dir = '/Users/roblogan/Documents/FakeFastaFiles';
my #ArrayofFiles = glob "$dir/*.fasta";
foreach my $filename (#ArrayofFiles) {
my $RawSequence = loadSequence($filename);
# ...
}
You seem to be trying to open files twice. The line
my #ArrayofFiles = glob "$dir/*.fasta";
Gives you the list of files. Then
foreach my $file (#ArrayofFiles){
open (my $Opened, $file) or die "can't open file: $!";
while (my $OpenedFile = <$Opened>) {
my $RawSequence = loadSequence($OpenedFile);
# ...
does the following, line by line. It iterates through files, opens each, reads a line from it, and then submits that line to the function loadSequence().
However, in that function you attempt to open a file again
sub loadSequence{
my ($sequenceFile) = #_;
my $sequence = "";
unless (open(FASTA, "<", $sequenceFile)){
# ...
The $sequenceFile variable in the function is passed to the function as $OpenedFile -- which is a line in the file that is already opened and being read from, not the file name. While I am not certain about details of your code, the error you show seems to be consistent with this.
It may be that you are confusing the glob, which gives you the list of files, with the opendir which would indeed need a following readdir to access the files.
Try renaming $OpenedFile to, say, $line (which it is) and see how it looks then.

Perl line/delimiter file formatting syntax

I'm trying to figure out how to use a code that's written in perl, but am not very familiar with perl syntax. I was wondering if someone could tell me what the format of the file #metafilecache is? The code is failing to read the samplerate within the file, but I'm not sure how I have it formatted incorrectly. Here's the excerpt of the code I think is appropriate:
my $tnet = $ARGV[0];
my $tsta = $ARGV[1];
my $stadir = $ARGV[2];
if ( ! -d "$targetdir" ) {
mkdir "$targetdir" || die "Cannot create $targetdir: $?\n";
}
die "Cannot find PDF bin base dir: $pdfbinbase\n" if ( ! -d "$pdfbinbase" );
my %targetdays = ();
my %targetchan = ();
# Collect target files in the $pdfbinbase dir, limited by $changlob
foreach my $nsldir (glob("$pdfbinbase/{CHRYS}/$tnet.$tsta.*")) {
next if ( ! -d "$nsldir" ); # Limit to directories
# Extract location ID from directory name
my ($net,$sta,$loc) = $nsldir =~ /\/(\w+)\.(\w+)\.([\w-]+)$/;
if ( $net ne $tnet ) {
print "Target network ($tnet) != network ($net)\n";
next;
}
if ( $sta ne $tsta ) {
print "Target station ($tsta) != station ($sta)\n";
next;
}
foreach my $chandir (glob("$nsldir/$changlob")) {
next if ( ! -d "$chandir" ); # Limit to directories
# Extract channel code from directory name
my ($chan) = $chandir =~ /.*\/([\w\d]+)$/;
foreach my $yeardir (glob("$chandir/Y*")) {
next if ( ! -d "$yeardir" ); # Limit to directories
# Extract year from directory name
my ($year) = $yeardir =~ /^.*\/Y(\d{4,4})$/;
foreach my $daybin (glob("$yeardir/D*.bin")) {
next if ( ! -f "$daybin" ); # Limit to regular files
my ($day) = $daybin =~ /^.*\/D(\d{3,3})\.bin$/;
$targetdays{"$loc.$chan.$year.$day"} = $daybin;
$targetchan{"$loc.$chan"} = 1;
}
}
}
}
if ( $verbose > 1 ) {
print "Target days from PDF bin files:\n";
my $count = 0;
foreach my $tday (sort keys %targetdays) {
print "Target day: $tday => $targetdays{$tday}\n";
$count++;
}
print "Targets: $count\n";
}
# Remove targets that have already been calculated by checking
# results files against targets.
foreach my $tchan ( keys %targetchan ) {
my ($loc,$chan) = split (/\./, $tchan);
# Generate target file name
my $targetfile = undef;
if ( $loc ne "--" ) { $targetfile = "$targetdir/$prefix-$loc.$chan"; }
else { $targetfile = "$targetdir/$prefix-$chan"; }
print "\nChecking target file for previous results: $targetfile\n"
if ( $verbose );
next if ( ! -f "$targetfile" );
# Open result file and remove any targets that are included
open IN, "$targetfile" || next;
foreach my $line (<IN>) {
next if ( $line =~ /^YEAR\.DAY/ );
my ($year,$day) = $line =~ /^(\d+).(\d+)/;
# Delete this target
delete $targetdays{"$loc.$chan.$year.$day"};
}
close IN;
}
if ( $verbose > 1 ) {
print "Remaining target days:\n";
my $count = 0;
foreach my $tday (sort keys %targetdays) {
print "Target day: $tday => $targetdays{$tday}\n";
$count++;
}
print "Remaining Targets: $count\n";
}
my %targetfiles = ();
# Calculate and store PDF mode for each target day
TARGET: foreach my $tday (sort keys %targetdays) {
my ($loc,$chan,$year,$day) = split (/\./, $tday);
my %power = ();
my %count = ();
my #period = ();
# Determine sampling rate
my $samprate = GetSampRate ($tnet,$tsta,$loc,$chan);
print "Samplerate for $tnet $tsta $loc $chan is: $samprate\n" if (
$verbose );
if ( ! defined $samprate ) {
if ( ($tsta eq "ECSD") || ($tsta eq "SFJ") || ($tsta eq "CASEE") ||
($tsta eq "JSC") ){
next;
}
else {
print "Cannot determine sample rate for channel
$tnet.$tsta.$loc.$chan\n";
next;
}
}
This is the subroutine GetSampRate:
sub GetSampRate { # GetSampRate (net,sta,loc,chan)
my $net = shift;
my $sta = shift;
my $loc = shift;
my $chan = shift;
my $samprate = undef;
# Generate source name: Net_Sta_Loc_Chan
my $srcname = "${net}_${sta}_";
$srcname .= ($loc eq "--") ? "_" : "${loc}_";
$srcname .= "$chan";
if ( $#metafilecache < 0 ) {
my $metafile = "$stadir/metadata.txt";
if ( ! -f "$metafile" ) {
print "GetSampRate(): Cannot find metadata file: $metafile\n";
return undef;
}
# Open metadata file
if ( ! (open MF, "<$metafile") ) {
print "GetSampRate(): Cannot open: $metafile\n";
return undef;
}
# Read all lines in the metafilecache
#metafilecache = <MF>;
close MF;
}
# Read all lines starting with srcname into #lines
my #lines = grep { /^$srcname/ } #metafilecache;
# Find maximum of sample rates for this channel
foreach my $line ( #lines ) {
my #fields = split(/\t/, $line);
my $rate = $fields[7];
$samprate = $rate if (!defined $samprate || $rate > $samprate);
}
return $samprate;
}
The code you have shown is very clunky.
As far this scope is concerned, the file is called $stadir/metadata.txt and I can't help with $stadir as it's either undefined or a global value that is set elsewhere — not a great design idea
After that, #metafilecache = <MF> loads the entire file into the array #metafilecache, leaving a trailing newline character at the end of each element
Then my #lines = grep { /^$srcname/ } #metafilecache duplicates to #lines all lines beginning with the string held in $srcname. This is another global variable that shouldn't be used
The following for loop splits the line on tab ("\t" or "\x09") separators and sets $rate to the eighth value ($fields[7]). $samprate is updated at each iteration if the latest value of $rate is greater than the current stored maximum
I hope that helps

Renaming files using hash table in perl

I have made a perl code which is shown below. Here what I am trying to do is first get input from a text file consisting of a HTTP URL with a Title.
thus the first regex is the title and the second regex fetches the id from inside the URL.
All these values are inserted into the hash table %myfilenames().
So this hash table has key as the URL id, and value as the Title. Everything till here works fine, now I have a set of files on my computer which have the ID in their name which we extracted from the URL.
What I want to do is that if the ID is there in the hash table, then the files name should change to the value assigned to the ID. Now the output at the print statement in the last function is correct but I am unable to rename the files. I tried many things, but nothing works. Can someone help please.
example stuff:
URL: https://abc.com/789012 <--- ID
Value (new Title) : ABC
file name on computer = file-789012 <---- ID
new file name = ABC
My code:
use File::Slurp;
use File::Copy qw(move);
open( F, '<hadoop.txt' );
$key = '';
$value = '';
%myfilenames = ();
foreach (<F>) {
if ( $_ =~ /Lecture/ ) {
$value = $_;
}
if ( $_ =~ /https/ ) {
if ( $_ =~ /\d{6}/ ) {
$key = $&;
}
}
if ( !( $value eq '' || $key eq '' ) ) {
#print "$key\t\t$value";
$myfilenames{$key} = $value;
$key = '';
$value = '';
}
}
#while ( my ( $k, $v ) = each %myfilenames ) { print "$k $v\n"; }
my #files = read_dir 'C:\\inputfolder';
for (#files) {
if ( $_ =~ /\d{6}/ ) {
$oldval = $&;
}
$newval = $myfilenames{$oldval};
chomp($newval);
print $_ , "\t\t$newval" . "\n";
$key = '';
}
You probably didn't prepend the path to the file names. The following works for me (on a Linux box):
#!/usr/bin/perl
use warnings;
use strict;
use File::Slurp qw{ read_dir };
my $dir = 0;
mkdir $dir;
open my $FH, '>', "$dir/$_" for 123456, 234567;
my $key = my $value = q();
my %myfilenames = ();
for (<DATA>) {
chomp;
$value = $_ if /Lecture/;
$key = $1 if /https/ and /(\d{6})/;
if ($value ne q() and $key ne q()) {
$myfilenames{$key} = $value;
$key = $value = q();
}
}
my #files = read_dir($dir);
for (#files) {
if (/(\d{6})/) {
my $oldval = $1;
my $newval = $myfilenames{$oldval};
rename "$dir/$oldval", "$dir/$newval";
}
}
__DATA__
Lecture A1
https://123456
# Comment
Lecture A2
https://234567