SoFunction
Updated on 2025-04-14

perl study materials compilation page 4/4


--------------------------------------------------------------------------------
return
Perl's array (array)
return
--------------------------------------------------------------------------------
File name change
use strict;
my(%t,@fld,$n);
open(IN,"") or die "Can't open the file ";
while(<IN>){
if (/^site/) {
@fld = split;
push(@{ $t{list} },$fld[0]);
}
}
close(IN);
for $n ( 0 .. $#{ $t{list} } ) {
$t{NO} = $n + 1;
$t{NO} = sprintf("%02d",$t{NO});
$t{filem} = 'sitem' . $t{NO} . '.htm';
$t{filenew} = 'site' . $t{NO} . '.htm';
system("rename $t{filem} $t{filenew}");
print "$t{filem}==>$t{filenew}\n";
}
exit;
for $n ( 0 .. $#{ $t{list} } ) {
$t{file1} = $t{list}[$n];
$t{NO} = $n + 1;
$t{NO} = sprintf("%02d",$t{NO});
$t{filem} = 'sitem' . $t{NO} . '.htm';
$t{filenew} = 'site' . $t{NO} . '.htm';
print "$t{file1}==>$t{filem}\n";
system("rename $t{file1} $t{filem}");
}
print "\n";

Rename all jpg files in a directory
my(%t,@list,$n);
@list = glob("*.jpg");
for $n ( 0 .. $#list ) {
$t{old_file} = $list[$n];
$t{e1} = sprintf("%02d",$n);
$t{new_file} = 'e' . $t{e1} . '.jpg';
system("rename $t{old_file} $t{new_file}");
print "$t{new_file}<==$t{old_file}\n";
}

Merge the same items in an array
use strict;
my(@list,%seen,@uniq,$item);
@list = (3,3,3,2,2,4,4,4,4);
%seen = ();
@uniq = ();
print"list=@list\n";
foreach $item (@list) {
unless ( $seen{$item} ) {
$seen{$item} = 1;
push(@uniq,$item);
}
}
print"uniq=@uniq\n";
# Program execution results
# list=3 3 3 2 2 4 4 4 4
# uniq=3 2 4
Put the first item in a line to the end
use strict;
my(%t,$n,@fld);
open(IN,"") or die "Can't open the file \n";
open(OUT,">");
while(<IN>) {
@fld = split;
$t{e1} = '';
for $n ( 1 .. $#fld ) {
$t{e1} .= $fld[$n] . ' ';
}
print OUT $t{e1},$fld[0],"\n";
}
close(IN);
close(OUT);
Decompose a two-layer array (for database processing)
$t{QTY} = '50=30=80=70==80';
print "QTY==>$t{QTY}\n";
@{ $t{QTY1} } = split(/==/,$t{QTY});
for $n ( 0 .. $#{ $t{QTY1} } ) {
$t{QTY2} = $t{QTY1}[$n];
print ' ',"QTY2==>$t{QTY2}\n";

@{ $t{QTY3} } = split(/=/,$t{QTY2});
for $n1 ( 0 .. $#{ $t{QTY3} } ) {
$t{QTY4} = $t{QTY3}[$n1];
print ' ',"QTY4==>$t{QTY4}\n";
}
}
__END__
Output execution results
QTY==>50=30=80=70==80
QTY2==>50=30=80=70
QTY4==>50
QTY4==>30
QTY4==>80
QTY4==>70
QTY2==>80
QTY4==>80
Count the number of parts of a single order (for database processing)
$$ref{A} = '3=4==5=6==7';
print "A=>$$ref{A}\n";
($ref) = get_length($ref);
print "length=>$$ref{NO}\n";
sub get_length {
my ($ref) = @_;
my (%t,$n);
@{ $t{As} } = split(/=/,$$ref{A});
$$ref{NO} = 0;
for $n ( 0 .. $#{ $t{As} } ) {
$t{A1} = $t{As}[$n];
if ( $t{A1} != 0 ) {
$$ref{NO}++;
}
}
return ($ref);
}
result:
A=>3=4==5=6==7
length=>5

--------------------------------------------------------------------------------
return
Utilize HTML::Template module
hour
--------------------------------------------------------------------------------
Generate multiple HTML files linked to each other
# Through this program, generate an HMLT table with hundreds of rows of data
#
use strict;
use HTML::Template;
my(%t,@fld,$n,$template,@loop);
print "Please input filename=";
chop($t{root}=<STDIN>);
$t{tmpl} = '';
$t{inputf} = $t{root} . '.txt';
open(IN,"") or die "Can't open the file .\n";
while(<IN>){
if ( /^NAME\s/ ) {
@fld = split;
$t{list}{$fld[1]} = $fld[2];
}
}
close(IN);
$template = HTML::Template->new(filename => $t{tmpl});
@loop = ();
$t{htmfile} = $t{root} . '.htm';
$t{flag} = 1;
open(IN,"$t{inputf}") or die "Can't open the file $t{inputf}";
while(<IN>){
next if $. == 1; # Skip the first line
next if length($_) < 2; # The last blank line is also skipped
if ( $t{flag} == 1 ) { # First set of data
$t{flag} = 2;
push(@{ $t{N1s} },$_);
$t{N11} = $_;
} elsif ($t{flag} == 2) { # Second set of data
$t{clist}{$t{N11}} = $_;
$t{flag} = 3;
} elsif ($t{flag} == 3) { # The third set of data
$t{elist}{$t{N11}} = $_;
$t{flag} = 1;
}
}
close(IN);
# Sort by first set of data
@{ $t{NN} } = sort {lc($a) cmp lc($b)} @{ $t{N1s} };
# In order to check for errors in input data, it is best not to sort the first time you run it
#@{ $t{NN} } = @{ $t{N1s} };
for $n ( 0 .. $#{ $t{NN} } ) {
$t{N1} = $t{NN}[$n];
$t{c1} = $t{clist}{$t{N1}};
$t{e1} = $t{elist}{$t{N1}};
$t{count}{$t{N1}}++;
if ( $t{count}{$t{N1}} > 1 ) { # This operation is to prevent duplication
next;
}
my %row = (
N1 => $t{N1},
C1 => $t{c1},
E1 => $t{e1}
);
push(@loop, \%row);
}
$t{etitle} = uc($t{root});
$template->param(std_loop => \@loop);
$template->param(ename => $t{etitle});
$template->param(cname => $t{list}{$t{etitle}});
open(OUT,">$t{htmfile}");
print OUT $template->output;
close(OUT);
print "The output file is $t{htmfile}\n";
__END__;
filename:
NAME ANSI United States
NAME BS United Kingdom
NAME DIN Germany
NAME EN Europe
NAME GB China
NAME ISO ISO
NAME JIS Japan
NAME NF France
<table width=75% align="center" border=1 cellpadding=5>
<tr bgcolor="#3399FF" align="center"><th width=20%>number</th><th width=40%>Chinese name</th><th width=40%>English name</th></tr>
<TMPL_LOOP NAME="std_loop">
<tr bgcolor="lightcyan" align="left"><td><TMPL_VAR NAME="N1"></td><td><TMPL_VAR NAME="C1"></td><td><TMPL_VAR NAME="E1"></td></tr>
</TMPL_LOOP>
</table>

Generate hundreds of HTML files in one go
# make_html.pl
use strict;
use HTML::Template;
my(%t,@fld,$n,$template,@loop,$h_ref);
print "Please input the directory name=";
chop($t{root}=<STDIN>);
$$h_ref{dir} = 'vF' . $t{root};
$t{inputf} = $t{root} . '_vF.csv';
open(IN,"./$$h_ref{dir}/$t{inputf}") or die "Can't open the file /$$h_ref{dir}/$t{inputf}.\n";
while(<IN>){
next if ( $. == 1 );
chop;
@fld = split(/,/);
next unless $fld[1];
$t{T1} = sprintf("%10.6f",$fld[0]);
push(@{ $$h_ref{Time} },$t{T1});
push(@{ $$h_ref{k_files} },$fld[1]);
push(@{ $$h_ref{Start} },$fld[2]);
}
close(IN);
$t{tmpl} = '';
$t{htmfile} = '';
$template = HTML::Template->new(filename => $t{tmpl});
opendir(DIR,"$$h_ref{dir}") or die "Can't opendir $$h_ref{dir}: $!";
@loop = ();
$t{N1} = 0;
for $n ( 0 .. $#{ $$h_ref{Time} } ) {
$t{N1}++;
$t{Time1} = $$h_ref{Time}[$n];
$t{file1} = $$h_ref{k_files}[$n];
$t{Start1} = $$h_ref{Start}[$n];
$t{csv1} = '<a href="' . $t{file1} . '">' . $t{file1} . '</a>';
$t{file1} =~ s/csv/xls/;
$t{xls1} = '<a href="' . $t{file1} . '">' . $t{file1} . '</a>';
$t{file1} =~ s/xls/htm/;
$t{gif1} = '<a href="' . $t{file1} . '">' . $t{file1} . '</a>';
my %row = (
N1 => $t{N1},
Time => $t{Time1},
csv => $t{csv1},
xls => $t{xls1},
gif => $t{gif1},
Start => $t{Start1}
);
push(@loop, \%row);
}
$template->param(loop => \@loop);
$template->param(dir => $$h_ref{dir});
open(OUT,">./$$h_ref{dir}/$t{htmfile}");
print OUT $template->output;
close(OUT);
# This cycle can generate a specified number of HTML files in one go
for $n ( 0 .. $#{ $$h_ref{Time} } ) {
$$h_ref{file1} = $$h_ref{k_files}[$n];
($h_ref) = make_vhtm($h_ref);
}
close(IN1);
print "Finished.\n";
sub make_vhtm {
my($h_ref) = @_;
my(%t,$n,$template1,@loop);
$$h_ref{file1} =~ s/csv/htm/;
$t{htmfile} = $$h_ref{file1};
$template1 = HTML::Template->new(filename => "");
$template1->param(htm => $t{htmfile});
$$h_ref{file1} =~ s/htm/gif/;
$template1->param(gif => $$h_ref{file1});
open(OUT1,">./$$h_ref{dir}/$t{htmfile}");
print OUT1 $template1->output;
close(OUT1);
return($h_ref);
}
1;
__END__;

error message
$template = HTML::Template->new(filename => $$h_ref{tmpl},option => "$$h_ref{NO}");
-------------------------------------
Please input the directory name=1_2_1
The output file is ./vF1_2_1/
HTML::Template->new() called with odd number of option parameters - should be of
the form option => value at make_html.pl line 78

--------------------------------------------------------------------------------
hour
opendir
hour
--------------------------------------------------------------------------------
(The key point of this program is to use opendir)
#
use strict;
use HTML::Template;
my(%t,@fld,$n,$template,@loop);
$t{tmpl} = '';
$t{htmfile} = '';
$template = HTML::Template->new(filename => $t{tmpl});
print "Please input the directory name=";
chop($t{dir}=<STDIN>);
opendir(DIR,"$t{dir}") or die "Can't opendir $t{dir}: $!";
while ( defined($t{file}=readdir(DIR)) ) {
next if $t{file} =~ /^\.\.?$/; # skip . and ..
if ( substr($t{file},-3) eq 'csv' ) {
$t{NO1} = $t{file};
substr($t{NO1},-4) = '';
substr($t{NO1},0,9) = '';
$t{list}{$t{NO1}} = $t{file};
}
}
close(DIR);
@loop = ();
$t{N1} = 0;
for $n ( sort {$a<=>$b} keys %{ $t{list} } ) {
$t{N1}++;
$t{file} = $t{list}{$n};
$t{N3} = '<a href="' . $t{file} . '">' . $t{file} . '</a>';
my %row = (
N1 => $t{N1},
N2 => $n,
file => $t{N3}
);
push(@loop, \%row);
}
$template->param(loop => \@loop);
$template->param(dir => $t{dir});
open(OUT,">./$t{dir}/$t{htmfile}");
print OUT $template->output;
close(OUT);
print "The output file is ./$t{dir}/$t{htmfile}\n";
__END__;

--------------------------------------------------------------------------------
hour
# color_index.pl
use strict;
use HTML::Template;
my(%t,@fld,$n,$template,@loop);
print "Please input filename=";
chop($t{root}=<STDIN>);
$t{tmpl} = $t{root} . '';
$t{inputf} = $t{root} . '.txt';
$template = HTML::Template->new(filename => $t{tmpl});
@loop = ();
$t{htmfile} = $t{root} . '';
$t{flag} = 1;
open(IN,"$t{inputf}") or die "Can't open the file $t{inputf}";
while(<IN>){
next if $. == 1;
next if length($_) < 2;
chop;
if ( $t{flag} == 1 ) {
$t{flag} = 2;
push(@{ $t{N1s} },$_);
$t{N11} = $_;
} elsif ($t{flag} == 2) {
$t{clist}{$t{N11}} = $_;
$t{flag} = 3;
} elsif ($t{flag} == 3) {
$t{elist}{$t{N11}} = $_;
$t{flag} = 1;
}
}
close(IN);
#@{ $t{NN} } = sort @{ $t{N1s} };
@{ $t{NN} } = @{ $t{N1s} };
for $n ( 0 .. $#{ $t{NN} } ) {

$t{N1} = $t{NN}[$n];
$t{c1} = $t{clist}{$t{N1}};
$t{e1} = $t{elist}{$t{N1}};
$t{content} = $t{N1} . '<br>' . $t{c1} . '<br>' . $t{e1};
$t{c11} = substr($t{c1},2,2);
$t{c12} = substr($t{c1},4,2);
$t{c13} = substr($t{c1},6,2);
$t{c14} = substr($t{c1},8,2);
$t{c1} = '#' . $t{c14} . $t{c13} . $t{c12} . $t{c11};
$t{color1} = '<td bgcolor="' . $t{c1} . '"> </td>';
$t{content1} = '<td>' . $t{content} . '</td>';
push(@{ $t{colors} },$t{color1});
push(@{ $t{contents} },$t{content1});
}
$t{C1} = 8;
$t{C4} = 1;
$t{line1} = $t{line2} = 0;
for $n ( 0 .. $#{ $t{colors} } ) {

$t{color1} = $t{colors}[$n];
$t{content1} = $t{contents}[$n];
$t{C2} = int($n/$t{C1});
$t{C3} = abs($n/$t{C1}-int($n/$t{C1}));
if ( $t{C2} > $t{C4} ) {
$t{C4}++;
}
if ( $t{C3} < 0.0000001 ) {
if ( !($t{line1}) ) {
$t{line1} = '<tr>' . $t{color1};
} else {
$t{line1} .= '</tr>';
push(@{ $t{lines} },$t{line1});
$t{line1} = '<tr>' . $t{color1};
}
} elsif ( $n == 55 ) {
$t{line1} .= $t{color1} . '</tr>';
push(@{ $t{lines} },$t{line1});
} else {
$t{line1} .= $t{color1};
}
if ( $t{C3} < 0.0000001 ) {
if ( !($t{line2}) ) {
$t{line2} = '<tr>' . $t{content1};
} else {
$t{line2} .= '</tr>';
push(@{ $t{lines} },$t{line2});
$t{line2} = '<tr>' . $t{content1};
}
} elsif ( $n == 55 ) {
$t{line2} .= $t{content1} . '</tr>';
push(@{ $t{lines} },$t{line2});
} else {
$t{line2} .= $t{content1};
}
}
for $n ( 0 .. $#{ $t{lines} } ) {
$t{line1} = $t{lines}[$n];
my %row = (
line1 => $t{line1}
);
push(@loop, \%row);
}
$template->param(loop => \@loop);
open(OUT,">$t{htmfile}");
print OUT $template->output;
close(OUT);
---------------------------------------------------
ColorIndex
1
&H000000
RGB(0,0,0)
53
&H003399
RGB(153,51,0)
52
&H003333
RGB(51,51,0)
51
&H003300
RGB(0,51,0)
49
&H663300
RGB(0,51,102)
11
&H800000
RGB(0,0,128)
55
&H993333
RGB(51,51,153)
56
&H333333
RGB(51,51,51)
9
&H000080
RGB(128,0,0)
46
&H0066FF
RGB(255,102,0)
12
&H008080
RGB(128,128,0)
10
&H008000
RGB(0,128,0)
14
&H808000
RGB(0,128,128)
5
&HFF0000
RGB(0,0,255)
47
&H996666
RGB(102,102,153)
16
&H808080
RGB(128,128,128)
3
&H0000FF
RGB(255,0,0)
45
&H0099FF
RGB(255,153,0)
43
&H00CC99
RGB(153,204,0)
50
&H669933
RGB(51,153,102)
42
&HCCCC33
RGB(51,204,204)
41
&HFF6633
RGB(51,102,255)
13
&H800080
RGB(128,0,128)
48
&H969696
RGB(150,150,150)
7
&HFF00FF
RGB(255,0,255)
44
&H00CCFF
RGB(255,204,0)
6
&H00FFFF
RGB(255,255,0)
4
&H00FF00
RGB(0,255,0)
8
&HFFFF00
RGB(0,255,255)
33
&HFFCC00
RGB(0,204,255)
54
&H663399
RGB(153,51,102)
15
&HC0C0C0
RGB(192,192,192)
38
&HCC99FF
RGB(255,153,204)
40
&H99CCFF
RGB(255,204,153)
36
&H99FFFF
RGB(255,255,153)
35
&HCCFFCC
RGB(204,255,204)
34
&HFFFFCC
RGB(204,255,255)
37
&HFFCC99
RGB(153,204,255)
39
&HFF99CC
RGB(204,153,255)
2
&HFFFFFF
RGB(255,255,255)
17
&HFF9999
RGB(153,153,255)
18
&H663399
RGB(153,51,102)
19
&HCCFFFF
RGB(255,255,204)
20
&HFFFFCC
RGB(204,255,255)
21
&H660066
RGB(102,0,102)
22
&H8080FF
RGB(255,128,128)
23
&HCC6600
RGB(0,102,204)
24
&HFFCCCC
RGB(204,204,255)
25
&H800000
RGB(0,0,128)
26
&HFF00FF
RGB(255,0,255)
27
&H00FFFF
RGB(255,255,0)
28
&HFFFF00
RGB(0,255,255)
29
&H800080
RGB(128,0,128)
30
&H000080
RGB(128,0,0)
31
&H808000
RGB(0,128,128)
32
&HFF0000
RGB(0,0,255)
Previous page1234Read the full text