CGI プログラム１１
戻る
<![CDATA[
# test2.pl
use strict;
my(%t,$n);
print "This is test2.pl\n";
$t{list1} = '23==2==5';
$t{list2} = '56=57==88=22==99';
$t{list2_1} = '5';
$t{list2_2} = '59';
if ( $t{list1} =~ /$t{list2_1}/ ) {
@{ $t{list1s} } = split(/==/,$t{list1});
for $n ( 0 .. $#{ $t{list1s} }) {
if ( $t{list1s}[$n] == $t{list2_1} ) {
$t{NO} = $n;
}
}
} else {
print "NO match!\n";
}
@{ $t{list2news} } = ();
if ( $t{list2} == 0 ) { # パーツが存在しない場合
$t{list2new} = $t{list2_2};
} else {
@{ $t{list2s} } = split(/==/,$t{list2});
$t{list2new} = '';
if ( $t{NO} > $#{ $t{list2s} } ) {
$t{list2new} = $t{list2} . '==' . $t{list2_2};
} else {
for $n ( 0 .. $#{ $t{list2s} } ) {
if ( $n == $t{NO} ) {
$t{list2new1} = $t{list2s}[$n] . '=' . $t{list2_2};
push(@{ $t{list2news} },$t{list2new1});
} else {
push(@{ $t{list2news} },$t{list2s}[$n]);
}
}
}
}
if ( $t{list2new} == 0 ) {
$t{list2new} = join('==',@{ $t{list2news} });
}
print "list1 => $t{list1}\n";
print "list2 => $t{list2}\n";
print "list2new => $t{list2new}\n";
__END__
his is test2.pl
list1 => 23==2==5
list2 => 56=57==88=22==99
list2new => 56=57==88=22==99=59
------------------------------------------------------------------------
# test3.pl
use strict;
my(%t,$n,$p_ref);
print "This is test3.pl\n";
$$p_ref{list1} = '35==42==10==14';
$$p_ref{list2} = '23=3431=3428=3432=3661';
$$p_ref{main_type1id} = '35';
$$p_ref{id2} = '3426';
($p_ref) = parts($p_ref);
print "list2new==>$$p_ref{list2new}\n";
sub parts {
my($p_ref) = @_;
my(%t,$n);
$t{list1} = $$p_ref{list1};
$t{list2} = $$p_ref{list2};
$t{list2_1} = $$p_ref{main_type1id};
$t{list2_2} = $$p_ref{id2};
if ( $t{list1} =~ /$t{list2_1}/ ) {
@{ $t{list1s} } = split(/==/,$t{list1});
for $n ( 0 .. $#{ $t{list1s} }) {
if ( $t{list1s}[$n] == $t{list2_1} ) {
$t{NO} = $n;
}
}
} else {
print "NO match!\n";
}
@{ $t{list2news} } = ();
if ( $t{list2} == 0 ) { # パーツが存在しない場合
$t{list2new} = $t{list2_2};
} else {
@{ $t{list2s} } = split(/==/,$t{list2});
$t{list2new} = '';
if ( $t{NO} > $#{ $t{list2s} } ) {
$t{list2new} = $t{list2} . '==' . $t{list2_2};
} else {
for $n ( 0 .. $#{ $t{list2s} } ) {
if ( $n == $t{NO} ) {
$t{list2new1} = $t{list2s}[$n] . '=' . $t{list2_2};
push(@{ $t{list2news} },$t{list2new1});
} else {
push(@{ $t{list2news} },$t{list2s}[$n]);
}
}
}
}
if ( $t{list2new} == 0 ) {
$t{list2new} = join('==',@{ $t{list2news} });
}
$$p_ref{list2new} = $t{list2new};
return($p_ref);
}
__END__;
------------------------------------------------------------------------
# test4.pl
use strict;
my(%t,$n,$p_ref);
print "This is test4.pl\n";
$$p_ref{NO1} = '2';
$$p_ref{id2} = '33';
$$p_ref{list2} = '23=3431=3428=3432=3661==34=33';
($p_ref) = parts2($p_ref);
print "list2new==>$$p_ref{list2new}\n";
sub parts2 {
my($p_ref) = @_;
my(%t,$n,$n1);
$t{list2} = $$p_ref{list2};
$t{NO1} = $$p_ref{NO1};
$t{id2} = $$p_ref{id2};
@{ $t{list2s} } = split(/==/,$t{list2});
@{ $t{list2snew} } = ();
@{ $t{list2ssnew} } = ();
for $n ( 0 .. $#{ $t{list2s} }) {
$t{NO2} = $n + 1;
if ( $t{NO1} == $t{NO2} ) {
@{ $t{list2ss} } = split(/=/,$t{list2s}[$n]);
for $n1 ( 0 .. $#{ $t{list2ss} } ) {
next if ( $t{id2} == $t{list2ss}[$n1] );
push(@{ $t{list2ssnew} },$t{list2ss}[$n1]);
}
$t{list2new} = join('=',@{ $t{list2ssnew} });
push(@{ $t{list2snew} },$t{list2new});
} else {
push(@{ $t{list2snew} },$t{list2s}[$n]);
}
}
$$p_ref{list2new} = join('==',@{ $t{list2snew} });
return($p_ref);
}
__END__;
]]>
戻る