fork download
copy 
  1. #!/usr/bin/env perl
  2. ######################################
  3. #      $URL: http://m...content-available-to-author-only...d.ru $
  4. #     $Date: 2011-10-12 19:53:20 +0300 (Web, 14 Sep 2011) $
  5. #   $Author: mishin nikolay $
  6. #   $Revision: 1.02 $
  7. #   $Source: gen_date_regexp.pl $
  8. #   $Description: generate regexp basically on date $
  9. #   $Jira: FRWA-16401
  10. #   Summit // Optimise the routine that searches UTP messages in FCL PROD archives / logs
  11. #   give 02-Apr-2011 as input
  12. #       Start date limiting the the search scope, i.e. this allows
  13. #       to ignore trade versions received earlier than the specified date (optional)
  14. #   regexp must be as
  15. #    'qr/.*2011.*[^xg]{1}.zip$/'
  16. ##############################################################################
  17. use strict;
  18. use warnings;
  19.  
  20. use utf8;
  21. use Data::Dumper;
  22. use Carp;
  23. use Time::Local;
  24. use POSIX;
  25. #use Smart::Comments;
  26.  
  27. use English qw(-no_match_vars);
  28. use Regexp::Assemble;
  29.  
  30. our $VERSION = '0.01';
  31.  
  32. my $input_date = '02-Apr-2011';
  33.  
  34. #good idea to set period 02-Apr-2011..04-May-2012
  35.  
  36. #create month hash
  37. my %months;
  38.  
  39. # two symbol for correct literal matching
  40. @months{qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec )} =
  41.   ( '01' .. '12' );
  42.  
  43. my $RGX_DATE = qr{(\d{2})-(\w{3})-(\d{4})}smo;
  44. my ( $day, $mon_word, $mon, $year );
  45. if ( $input_date =~ /$RGX_DATE/sm ) {
  46.     ( $day, $mon_word, $year ) = ( $1, ucfirst($2), $3, );
  47.     $mon = $months{$mon_word};
  48. }
  49. ### $year
  50. ### $mon
  51. my $max_day = get_mon_len( $year, $mon );
  52. ### $max_day;
  53.  
  54. #my $mon = 'Apr';
  55. my @test_file_name = ();
  56.  
  57. #generate test date for generate regexp
  58. for my $day ( $day .. $max_day ) {
  59.     push @test_file_name,
  60.       sprintf( '%02d', $day ) . '-' . $mon_word . '-' . $year;
  61. }
  62.  
  63. my $re = Regexp::Assemble->new->add(@test_file_name);
  64.  
  65. print "$re\n";    #(?-xism:(?:0[23456789]|[12]\d|30)-Apr-2011)
  66.  
  67. while (<DATA>) {
  68.     chomp;
  69.     my $file_name = $_;
  70.     if ( $file_name =~ /$re/sm ) {
  71.         print $file_name, " found \n";
  72.     }
  73. }
  74.  
  75. sub get_mon_len {
  76.     my ( $year, $month ) = (@_);
  77.     do { warn "Invalid month: $month\n"; next }
  78.       if $month > 12 or $month < 1;
  79.     my $next_year = ( $month == 12 ) ? $year + 1 : $year;
  80.     my $next_month = timelocal( 0, 0, 0, 1, $month % 12, $next_year );
  81.     my $days = ( localtime( $next_month - 86_400 ) )[3];
  82.     return $days;
  83. }
  84.  
  85. __DATA__
  86. N1089767N_7_SWOPT_03-Jul-2011_78919186.xml
  87. N1089767N_7_SWOPT_25-Jun-2011_72745892.xml
  88. N1089772L_9_SWOPT_03-Jul-2011_78979055.xml
  89. N1089772L_9_SWOPT_01-Apr-2011_78979055.xml
  90. N1089772L_9_SWOPT_02-Apr-2011_78979055.xml
  91. N1089772L_9_SWOPT_22-Apr-2011_78979055.xml
  92. N1089772L_9_SWOPT_30-Apr-2011_78979055.xml
  93. N1089772L_9_SWOPT_20-Jul-2011_69380887.xml
  94. N1089772L_9_SWOPT_29-Jun-2011_74754662.xml
  95. message.110530033311A4259348AS26.A4259348AS_26_SWOPT_01-Jul-2011.xml
  96. message.110530033311A4259348AS26.A4259348AS_26_SWOPT_31-May-2011.xml
  97. A4259348AS_26_SWOPT_29-Jun-2011_74754662.xml
  98.  
Success #stdin #stdout 0.02s 5928KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
https://ideone.com/9S0DX
language:
Perl (perl 5.28.1)
created:
12 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!