package Seisan::Tools; use strict; #no strict "vars"; our ($s_timearray, $year, $mon, $mday, $hour, $min, $lineI, $line7, $mm, $dd, $lineone, $linesix, @sfilecontent, $storeline, $line, $sfc, $mserr, $tempfile, %epoch_times, $neworder, $d, %flipped_hash, @sorted, @times, @ordered_events, $log3); use DateTime::Precise; use Exporter; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); our $VERSION = 1.00; our @ISA = qw(Exporter); our @EXPORT = (); our @EXPORT_OK = qw( &sei2DP &nor2DP &sei2nor &nor2iso &sei2iso &make_s_file &add_to_s_file &now_epoch &sei_epoch &nor_epcoh &event_sorter); our %EXPORT_TAGS = ( DEFAULT => [qw(&sei2DP)], All => [qw(&sei2DP &nor2DP &sei2nor &nor2iso &sei2iso &make_s_file &add_to_s_file &now_epoch &sei_epoch &nor_epcoh $event_sorter)]); # 1 2 3 # 123456789012345678901234567890 # sei 2003-03-05-2202-42S.BRU2__003 # nor 18-1257-20L.S200303 # iso 1995:01:24T09:08:17 # DP 2003.9.4 23:58:58 sub sei2nor {substr($_[0],8,2)."-".substr($_[0],11,4)."-".substr($_[0],16,2)."L.S". substr($_[0],0,4).substr($_[0],5,2);} sub sei2iso {substr($_[0],0,4).":".substr($_[0],5,2).":".substr($_[0],8,2)."T". substr($_[0],11,2).":".substr($_[0],13,2).":".substr($_[0],16,2);} sub nor2iso {substr($_[0],13,4).":".substr($_[0],17,2).":".substr($_[0],0,2)."T". substr($_[0],3,2).":".substr($_[0],5,2).":".substr($_[0],8,2);} sub nor2DP {substr($_[0],13,4).".".substr($_[0],17,2).".".substr($_[0],0,2)." ". substr($_[0],3,2).":".substr($_[0],5,2).":".substr($_[0],8,2);} sub sei2DP {substr($_[0],0,4).".".substr($_[0],5,2).".".substr($_[0],8,2)." ". substr($_[0],11,2).":".substr($_[0],13,2).":".substr($_[0],16,2);} sub sei_epoch {int(DateTime::Precise->new(&sei2DP)->unix_seconds_since_epoch) } sub nor_epoch {int(DateTime::Precise->new(&nor2DP)->unix_seconds_since_epoch) } sub now_epoch {int(DateTime::Precise->new()->unix_seconds_since_epoch)} # ----------------- MAKE S FILE ---------------------------------------------- # ----------------- MAKE S FILE ---------------------------------------------- # ----------------- MAKE S FILE ---------------------------------------------- sub make_s_file { undef @sfilecontent; $s_timearray = DateTime::Precise->new; # make a new time object $year = $s_timearray->[0]; $mon = $s_timearray->[1]; $mday = $s_timearray->[2]; $hour = $s_timearray->[3]; $min = $s_timearray->[4]; if ($mon < 10) {$mon = "0".$mon;} if ($mday < 10) {$mday = "0".$mday;} if ($hour < 10) {$hour = "0".$hour;} if ($min < 10) {$min = "0".$min;} $lineI = " ACTION:MSN ".substr($year,2,2)."-".$mon."-".$mday." ".$hour.":".$min ." OP:alr STATUS:".(' ' x 16)."ID:".substr($_[0],0,4).substr($_[0],5,2) .substr($_[0],8,2).substr($_[0],11,4).substr($_[0],16,2)." L I"; $line7 = " STAT SP IPHASW D HRMM SECON CODA AMPLIT PERI AZIMU VELO SNR AR TRES W DIS CAZ7"; foreach my $ts3(@_) { if (substr($ts3,5,1) == "0") { $mm = " ".substr($ts3,6,1); } else { $mm = substr($ts3,5,2); } if (substr($ts3,8,1) == "0") { $dd = " ".substr($ts3,9,1); }else { $dd = substr($ts3,8,2); } $lineone = " ".substr($ts3,0,4)." ".$mm.$dd." ".substr($ts3,11,4)." ". substr($ts3,16,2).".0 L".(' ' x 57)."1"; $linesix = " ".$ts3.(' ' x 49)."6"; push (@sfilecontent,$lineone); push (@sfilecontent,$linesix); } splice (@sfilecontent,1,0,$lineI); push (@sfilecontent,$line7); return @sfilecontent; } # -------------- ADD TO S FILE -------------------------------------------------- # -------------- ADD TO S FILE -------------------------------------------------- # -------------- ADD TO S FILE -------------------------------------------------- sub add_to_s_file { undef $mserr; undef @sfilecontent; $tempfile = shift @_; if (-e !$tempfile) { return " Could not find s_file given, nothing added"; } open("sfile", "+<".$tempfile); select "sfile"; while ($_ = ) { push (@sfilecontent,$_); } chop @sfilecontent; close "sfile"; #Next we pop of the last line of the s_file and check to see that it #contain the letters "STAT" $storeline = pop @sfilecontent; loop: while (substr($storeline,1,4) ne "STAT") { $storeline = pop @sfilecontent; next loop; } loop2: foreach $_(@_) { #$line = $_; $line = shift @_; if (grep m/$line/, @sfilecontent) { #check to see if the file is already there $mserr = " Attemped to add $_ to an s_file but it was already there"; next loop2; # get the next file name } #$lineone = " ".substr($_,0,4)." ".substr($_,5,2).substr($_,8,2)." ".substr($_,11,4)." ". #substr($_,16,2).".0 L".(' ' x 57)."1"; $linesix = " ".$_.(' ' x 49)."6"; #push (@sfilecontent,$lineone); push (@sfilecontent,$linesix); } if (!@_) { push (@sfilecontent, $storeline); open("sfile", ">"."$tempfile"); select "sfile"; foreach $sfc(@sfilecontent) { print $sfc,"\n"; } close "sfile"; if (!$mserr) { $mserr = " $line added to ".unpack("x19 A26", "$tempfile"); #this line added Dec 23, 2003 } } if ($mserr) { return $mserr; } return undef; } # -------------- EVENT SORTER -------------------------------------------------- # -------------- EVENT SORTER -------------------------------------------------- # -------------- EVENT SORTER -------------------------------------------------- sub event_sorter { undef %epoch_times; undef %flipped_hash; undef @sorted; # first we take the array given to use and make a hash that has # the epoch times of the events foreach $d(@_) { $epoch_times{$d} = Seisan::Tools::sei_epoch($d); } # what I have now is @FTPed_events_file_names and epoch_times # epoch_times has epoch time as the value and event name as the key #first I will go through epoch_times and make a fliped hash by # going to each element and making a new array with the epoch as the key # and the name as the value. foreach (keys %epoch_times) { # from first Perl book page number 235 push (@times, $epoch_times{$_}); $flipped_hash{$epoch_times{$_}} = $_; } # now I sort the epoch_times array sub by_epoch { $a <=> $b } # this is a tiny subrouine form the first Perl book @sorted = sort by_epoch @times; # page number 248 foreach $neworder(@sorted) { push (@ordered_events, $flipped_hash{$neworder}); } undef %flipped_hash; undef @sorted; undef @times; return @ordered_events; } 1; # Needed as last line of a Package __END__; =head1 NAME Seisan::Tools =cut =head1 SYNOPSIS A tool box for use with Seisan and Nordic format seismic files =head1 DESCRIPTION A collection of tools, (subroutines) that convert Seisan and Nordic file names into a variety of time formats, ISO, Datetime::Precise and unix epoch =cut =head2 MODULES USED Date::Precise. This is a great module. It allows date arithmetic and keeps track of all date/time boundaries. With this module you can add a month to a date and the results will be right even if it is the Feb/March boundary in a leap year. You will have to download it from CPAN and install it. =cut =head2 TOOLS, (subroutines) =over4 =item* sei2nor - converters a Seisan file name into a Nordic filename i.e. 18-1257-20L.S200303 =item* sei2iso, nor2iso - these convert fiies into the ISO format i.e. 1995:01:24T09:08:17 =item* sei2DP and nor2DP converts filenames to DateTime::Precise acceptable format i.e. 2003.9.4 23:58:58 =item* sei2epoch, nor2epoch, now2epoch convert filenames and the present time to unix epoch time which the number of seconds since January 1, 1970 and returns it as an integer. =item* make_s_file - given an array of seisan filenames it will returns an array with the lines of the an Nordic s_file =item* add_to_s_file - given a complete path name to an existing s_file and an array of seisan filenames will go get the s_file and a add the filename from the array and then replace the old s_file with the new one. =item event_sorter - given an array of Seisan file names returns an array with those names sorted by unix epoch times earliest event first. =back =head1 AUTHOR Angel Rodriguez, bru2@tierrasaltas.com and if you want to spend your hard earned money you can call me at my cell phone in Panama 507 635 4613. I answer it when I am in the car. =cut =head1 Test Program use strict; no strict "vars"; use warnings; use Seisan::Tools; my $sei= "2003-03-05-2202-42S.BRU2__003"; print Seisan::Tools::sei2DP($sei),"\n"; print Seisan::Tools::sei2iso($sei),"\n"; print Seisan::Tools::sei2nor($sei),"\n"; print Seisan::Tools::nor2iso(Seisan::Tools::sei2nor($sei)),"\n"; print Seisan::Tools::nor2DP(Seisan::Tools::sei2nor($sei)),"\n"; print Seisan::Tools::now_epoch(),"\n"; print Seisan::Tools::sei_epoch($sei),"\n"; print Seisan::Tools::nor_epoch(Seisan::Tools::sei2nor($sei)),"\n"; print "\n"; use Seisan::Tools qw(:All); # another form of usage print sei2DP($sei),"\n"; print sei2iso($sei),"\n"; print sei2nor($sei),"\n"; print nor2iso(sei2nor($sei)),"\n"; print nor2DP(sei2nor($sei)),"\n","\n"; @sfilenames = ("2003-03-05-2202-42S.BRU2__003", "2003-03-05-2202-40S.POT2__003"); $place = 'C:\seismo\REA\ANG2_\2003\08\30-0601-17L.S200308'; @s_file_array = Seisan::Tools::make_s_file(@sfilenames); foreach $line(@s_file_array) { print $line,"\n"; } # to run this last test you must set $place to a real s_file and # uncomment the last line. $place = 'the complete path to an s_file here'; # you have to provide $place #Seisan::Tools::add_to_s_file($place, @sfilenames); exit; =head1 BUGS User Beware!! I am new programmer and even newer to Perl. I make no claims as to how this program will work under the many conditions that are out there. This was written for my personal use and enjoyment. Use this program as a starting point for your own program. That having been said, PLEASE do send me any bugs, errors and that you may find and I will do my best to fix them. I am also open to any enhancements you might suggest. =cut =head1 THANKS I would like to thank Jens Havskov for his encouragement and guidance. =cut =head1 LINKS You can find SeisNet, Seislog and Seisan at http:\\www.ifji.uib.nor\seismo\software =cut =head1 COPYRIGHT This program is free and you may use it anyway you want. =cut