perl 这么牛X的语言居然没人来？ - 编程论坛

#2

好学2010-03-11 16:54

超级不喜欢perl和php的代码风格，虽然都很强悍

#3

mywaylgh2010-03-12 15:08

一下perl 代码版权归 mywaylgh 所有，请尽情享用....

sub sortindex{
    # sortIndex: Get sort index.
    my @addArray = ();
    my @output = ();
    my @input = @_;
    #my @rrr = ();

    if (scalar(@input)==0) {
        die("ERRO using In sortIndex:A array must be input!\n");
    }
    if (scalar(@input)==1) {
        push(@input,"","");
    }elsif(scalar(@input)==2){
        push(@input,"");
    }

    # Make 2D array
    my $i  = 0;
    foreach my $Inarray_line (@{$input[0]}) {
        my @foradd = ($Inarray_line,$i);
            push (@addArray,\@foradd);
            $i++;
    }

    #sort 2D array by input array
    if ($input[1] eq "" or $input[1] eq "string") {
        if ($input[2] eq "descend" ) {
            @addArray= sort{$b->[0] cmp $a->[0]}@addArray;
        }elsif($input[2] eq "" or $input[2] eq "asscend") {
            @addArray= sort{$a->[0] cmp $b->[0]}@addArray;
        }else{
            die "ErrorIn::SortIndex: oder must be \"asscend\" or \"descend\" or null";
        }
    }elsif ($input[1] eq "number") {
        if ($input[2] eq "descend" ) {
            @addArray= sort{$b->[0] <=> $a->[0]}@addArray;
        }elsif($input[2] eq "" or $input[2] eq "asscend") {
            @addArray= sort{$a->[0] <=> $b->[0]}@addArray;
        }else{
            die "ErrorIn::SortIndex: oder must be \"asscend\" or \"descend\" or null";
        }
    }else{
        die "ErrorIn sortIndex: operation must be \"number\" or \"string\" or null ";
    }

    #write index for sorted
    #foreach my $outline (@addArray) {
    #    push(@output,$$outline[1]);
        #push(@rrr,$$outline[0]);
    #}
    @output = map{$_->[1]} @addArray;

    return @output;
    #return \@rrr,\@output;

}

[ 本帖最后由 mywaylgh 于 2010-3-12 15:09 编辑 ]

#4

mywaylgh2010-03-12 15:10

sub subarray{
    # Get sub array and resort by input index
    my @output = map {$_[0]->[$_]} @{$_[1]};
    return @output;
}

#5

mywaylgh2010-03-12 15:10

sub unique{
    #Get unique elements of an array.
    my %seen = ();
    my @output = grep { ! $seen{$_} ++ } @_;
    return @output;
}

#6

mywaylgh2010-03-12 15:11

sub intersect{
    #Get overlap between two arrays(uniqued).
    my %seen = ();
    my %look = ();
    foreach  (@{$_[0]}) {$seen{$_}=1;}
    my @output = grep{$seen{$_}==1 and ! $look{$_} ++} @{$_[1]};
    return @output;
}

#7

mywaylgh2010-03-12 15:11

sub html2txt{
    #html2txt
    if (scalar(@_)!=2) {die "2 nargin is accepted!"};
    my $intxt = "";
    open (INPUT,"$_[0]");
    while(<INPUT>){
        $intxt = $intxt.$_;
    }
    close INPUT;
    $intxt =~ s/\<[^\>]+\>//g;
    open (OUTPUT,">$_[1]");
    print OUTPUT $intxt;
    close OUTPUT;
}