Re: [Moscow.pm] transform sort function to Schwartzian Transform ??

[Nikolay Mishin]

Прогнал через perlcritic

оказывается в perl5 switch deprecated

 

#!/usr/bin/perl

######################################

#      $URL: http://mishin.narod.ru $

#     $Date: 2011-09-14 19:53:20 +0300 (Web, 14 Sep 2011) $

#   $Author: mishin nikolay $

# $Revision: 1.02 $

#   $Source: Sort_trades_get_latest.pl $

#   $Description: Sort trades and get latest $

##############################################################################

#use v5.10;

use strict;

use warnings;

our $VERSION = '0.01';

use Data::Dumper;

use Carp;

use English qw(-no_match_vars);

use lib '/rwa/data/team/MISHNIK/perl/utils/Perl6-Say-0.16/lib';

use lib '/rwa/data/team/MISHNIK/perl/utils/Switch-2.16';

use lib '/rwa/data/team/MISHNIK/perl/utils/List-UtilsBy-0.07/lib';

use lib '/rwa/data/team/MISHNIK/perl/utils/Readonly-1.03';

use Perl6::Say;

use List::UtilsBy qw( rev_sort_by );

use Readonly;

my %months;

@months{qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec )} =

  ( '00' .. '11' );

#                                 N1089767N_7_SWOPT_03-Jul-2011_78919186.xml

Readonly my $RGX_SHORT_MESS => qr/(\w+)_(\d{2})-(\w{3})-(\d{4})_(\d+)/ms;

#                                message.110530033311A4259348AS26.A4259348AS_26_SWOPT_01-Jul-2011.xml

Readonly my $RGX_LONG_MESS =>

  qr/message[.](\w+)[.](\w+)_(\d{2})-(\w{3})-(\d{4})/ms;

#my @file_names = <DATA>;

my $file = 'file_names.txt';

open my $fh, q{<}, $file or croak "unable to open:$file $ERRNO";

my @file_names = <$fh>;

close $fh or croak "unable to close: $file $ERRNO";

#print Dumper(\@file_names);

#print "@file_names";

### @file_names:@file_names

#rkeysort_inplace { make_trade_sortest($_) } @file_names;

my @sort_file_names = rev_sort_by { make_trade_sortest($_) } @file_names;

my %is_avaible;

foreach my $file_name (@file_names) {

    my ($trade_id);

    if ( $file_name =~ $RGX_SHORT_MESS ) {

        $trade_id = $1;

    }

    if ( $file_name =~ $RGX_LONG_MESS ) {

        $trade_id = $2;

    }

    if ( !$is_avaible{$trade_id} ) {

        print "$file_name";

    }

    $is_avaible{$trade_id}++;

}

### @file_names:@file_names

#function make name good for sort alphabetically

sub make_trade_sortest {

    my ($trade_file_name) = @_;

    my ( $trade_id, $date, $month, $year, $row_num );

    if ( $trade_file_name =~ $RGX_SHORT_MESS ) {

        ( $trade_id, $date, $month, $year, $row_num ) = ( $1, $2, $3, $4, $5 );

    }

    if ( $trade_file_name =~ $RGX_LONG_MESS ) {

        ( $row_num, $trade_id, $date, $month, $year ) = ( $1, $2, $3, $4, $5 );

    }

    $month = $months{$month};

    #print "$trade_id:$year-$month-$date:$row_num";

    return "$trade_id:$year-$month-$date:$row_num";

}

__DATA__

N1089767N_7_SWOPT_03-Jul-2011_78919186.xml

N1089767N_7_SWOPT_25-Jun-2011_72745892.xml

N1089772L_9_SWOPT_23-Jul-2011_78979055.xml

N1089772L_9_SWOPT_20-Jul-2011_69380887.xml

N1089772L_9_SWOPT_29-Jun-2011_74754662.xml

message.110530033311A4259348AS26.A4259348AS_26_SWOPT_01-Jul-2011.xml

message.110530033311A4259348AS26.A4259348AS_26_SWOPT_31-May-2011.xml

A4259348AS_26_SWOPT_29-Jun-2011_74754662.xml

14.09.2011, 15:36, "Nikolay Mishin" <m...@ya.ru>:

В итоге получилось такое решение:

use v5.10;

use Sort::Key qw(rkeysort_inplace);

use Readonly;

#use Smart::Comments;

my %months;

@months{qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec )} =

  ( '00' .. '11' );

#                                 N1089767N_7_SWOPT_03-Jul-2011_78919186.xml

Readonly my $RGX_SHORT_MESS => qr/(\w+)_(\d{2})-(\w{3})-(\d{4})_(\d+)/;

#                                message.110530033311A4259348AS26.A4259348AS_26_SWOPT_01-Jul-2011.xml

Readonly my $RGX_LONG_MESS => qr/message[.](\w+)[.](\w+)_(\d{2})-(\w{3})-(\d{4})/;

my @file_names = <DATA>;

### @file_names:@file_names

rkeysort_inplace { make_trade_sortest($_) } @file_names;

my %is_avaible;

foreach my $file_name (@file_names) {

    my ($trade_id);

    given ($file_name) {

        when ($RGX_SHORT_MESS) {

            $trade_id = $1;

        }

        when ($RGX_LONG_MESS) {

            $trade_id = $2;

        }

    }

    if ( !$is_avaible{$trade_id} ) {

        print "$file_name";

    }

    $is_avaible{$trade_id}++;

}

### @file_names:@file_names

#function make name good for sort alphabetically

sub make_trade_sortest {

    my ($trade_file_name) = @_;

    my ( $trade_id, $date, $month, $year, $row_num );

    given ($trade_file_name) {

        when ($RGX_SHORT_MESS) {

            ( $trade_id, $date, $month, $year, $row_num ) =

              ( $1, $2, $3, $4, $5 );

        }

        when ($RGX_LONG_MESS) {

            ( $row_num, $trade_id, $date, $month, $year ) =

              ( $1, $2, $3, $4, $5 );

        }

    }

    $month = $months{$month};

    return "$trade_id:$year-$month-$date:$row_num";

}

__DATA__

N1089767N_7_SWOPT_03-Jul-2011_78919186.xml

N1089767N_7_SWOPT_25-Jun-2011_72745892.xml

N1089772L_9_SWOPT_03-Jul-2011_78979055.xml

N1089772L_9_SWOPT_20-Jul-2011_69380887.xml

N1089772L_9_SWOPT_29-Jun-2011_74754662.xml

message.110530033311A4259348AS26.A4259348AS_26_SWOPT_01-Jul-2011.xml

message.110530033311A4259348AS26.A4259348AS_26_SWOPT_31-May-2011.xml

A4259348AS_26_SWOPT_29-Jun-2011_74754662.xml

10.09.2011, 21:00, "Nikolay Mishin" <m...@yandex.ru>:

А вот это - супер решение, приблизительно то, что я искал однострочник почти ;))

спасибо, к тому же, как я понимаю, его можно еще уменьшить и написать однострочник(пока не родился) :

  

<code> 

#!/perl -lan -F'_|-' --

@months{qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec )} =  ( '00' .. '11' );

$F[4] = {%months}->{ $F[4] };

$date = join '-', @F[ 5, 4, 3 ];

$R{ $F[0] } = { file => $_, date => $date }

  if !$R{ $F[0] }

      or $R{ $F[0] }{date} le $date;

}

  {

  print $R{$_}{file} for reverse sort keys %R;

<code>

 

1.    от  меня  насти  коли  спасибо   (это баловалась моя дочь)

10.09.2011, 13:45, "Alexander Onokhov" <ccn...@gmail.com>:

Я б скрипт переписал примерно так:

<code>

#!/perl -lan -F'_|-' --

$F[4] = { Jan => '01', Feb => '02', Mar => '03',

          Apr => '04', May => '05', Jun => '06',

          Jul => '07', Aug => '08', Sep => '09',

          Oct =>  10,  Nov =>  11,  Dec =>  12  }->{ $F[4] };

$date = join '-', @F[5,4,3];

$R{ $F[0] } = { file => $_, date => $date }

  if ! $R{ $F[0] } or $R{ $F[0] }{date} le $date;

}{

print $R{$_}{file} for reverse sort keys %R;

</code>

Комментарии проставить по вкусу

Вызов 
perl script.pl confile

2011/9/9 Nikolay Mishin <m...@ya.ru>

Hi Moscow PM

Помогите , есть программа, сортирующая файлы:
можно ли ее переписать с использованием Schwartzian Transform
типа @new = map { $_->[0] }
 sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] }
 map { [ $_, /=(\d+)/, uc($_) ] } @old;
у меня что-то не получается
#содержимое confile
# N1089767N_7_SWOPT_03-Jul-2011_78919186.xml
# N1089767N_7_SWOPT_25-Jun-2011_72745892.xml
# N1089772L_9_SWOPT_03-Jul-2011_78979055.xml
# N1089772L_9_SWOPT_20-Jul-2011_69380887.xml
# N1089772L_9_SWOPT_29-Jun-2011_74754662.xml
open( CONSULTS, "confile" );
@scons = <CONSULTS>;
close CONSULTS;
my %is_trade_id_unique;
foreach ( reverse sort consort @scons ) {
   chomp;
   if ( $_ =~ m/(\w+_\d+_\w+)_(\d+)-([A-Za-z]{3})-2011_(\d+)[.]xml/i ) {
       my ( $trade_id, $date, $month, $row_num ) = ( $1, $2, $3, $4 );
       if ( !$is_trade_id_unique{$trade_id} ) {
           print $_. "\n";
           $is_trade_id_unique{$trade_id} = 1;
       }
   }

}

#N1089767N_7_SWOPT_03-Jul-2011_78919186.xml
sub consort {
   $aa = $a;
   $bb = $b;

 # save our variables because our sort routine affects them.  If I "chomp $a"
 # that will actually change the line seen in the foreach loop that calls this.
   chomp $aa;
   chomp $bb;

   $aa =~ s/^  *//;
   $bb =~ s/^  *//;

   my %months = (
       FY  => 0,
       Jan => 1,
       Feb => 2,
       Mar => 3,
       Apr => 4,
       May => 5,
       Jun => 6,
       Jul => 7,
       Aug => 8,
       Sep => 9,
       Oct => 10,
       Nov => 11,
       Dec => 12,
   );

   my ( $trade_id,  $date,  $month,  $row_num );
   my ( $btrade_id, $bdate, $bmonth, $brow_num );
   if ( $aa =~ m/(\w+_\d+_\w+)_(\d+)-([A-Za-z]{3})-2011_(\d+)[.]xml/i ) {
       ( $trade_id, $date, $month, $row_num ) = ( $1, $2, $months{$3}, $4 );
   }
   if ( $bb =~ m/(\w+_\d+_\w+)_(\d+)-([A-Za-z]{3})-2011_(\d+)[.]xml/i ) {
       ( $btrade_id, $bdate, $bmonth, $brow_num ) =
         ( $1, $2, $months{$3}, $4 );
   }

        $trade_id cmp $btrade_id
     || $month <=> $bmonth
     || $date <=> $bdate
     || $row_num <=> $brow_num;

}

--
Moscow.pm mailing list
moscow-pm@pm.org | http://moscow.pm.org

--
Alexander

--
Moscow.pm mailing list
moscow-pm@pm.org | http://moscow.pm.org

--
Nikolay Mishin

 

--
Nikolay Mishin

--
Moscow.pm mailing list
moscow-pm@pm.org | http://moscow.pm.org

--
Nikolay Mishin

-- 
Moscow.pm mailing list
moscow-pm@pm.org | http://moscow.pm.org