Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations derfloh on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
Perl script design
- Thread starter marcel2
- Start date
Post your details and we'll see what we can do.
I don't follow, where is the script you are working with (local or web) and you're trying to execute it how, or the script is trying to execute...it's been a long day already and I'm getting confused. ----------------------------------------------------------------------------------
...but I'm just a C man trying to see the light
I don't follow, where is the script you are working with (local or web) and you're trying to execute it how, or the script is trying to execute...it's been a long day already and I'm getting confused. ----------------------------------------------------------------------------------
...but I'm just a C man trying to see the light
- Thread starter
- #3
The script has to work if this is in the html page
<!--#exec cgi="weather/cgi-bin/synops.pl"-->
But it is not doing anything the autor of the script told me the script is not a CGI script. It is just a command-line (as in unix/linux shell prompt) script. I hope you can get it to work. And are able to add the option for getting the synoptic file from the internet site
This is the script
#!/usr/bin/perl
# Example of input format:
#AAXX 17014
#94102 NIL=
#94200 NIL=
#94203 NIL=
#94211 NIL=
#94212 NIL=
#94214 31997 50000 10358 20214 30081 40099 51008 70410 85260=
#NNNN
#SMAA10 DEMS 170000
#AAXX 17004
#89514 42998 11824 11028 49903 52021 80002 333 10028 21030
#81075=
#NNNN
# Read in all input files, and split into messages
@text=<>;
@text=split_gts_synop(join("",@text));
# Go through the messages and decode the AAXX ones.
foreach $REPORT (@text) {
# Decode if AAXX
if ($REPORT=~/^AAXX/) {
($NAME,$YEAR,$MON,$DAY,$HOUR,$LA,$LO,$T,$DIR,$SPD,$IW,$CLOUD,$ICE,$DEWT,$PSTA,$PRED,$PTND_code,$PTND_value,$PPN_code,$PPN_value,$ST_TYPE,$WW,$W1,$W2,$NH,$CL,$CM,$CH,$CLOUD_H)
= decode_synop($REPORT);
# Output
print <<EOF;
Report:
$REPORT
Decoded:
Ident: $NAME; Date: $YEAR/$MON/$DAY:$HOUR; Location: $LA (Lat), $LO (Long); Type: $ST_TYPE
Pressure: $PSTA (station) / $PRED (MSLP) / $PTND_value [$PTND_code] (P Tend)
Temperature: $T / $DEWT (Dew Temp)
Wind: $DIR (Direction) / $SPD (speed)
Precipitation: $PPN_value [$PPN_code]
Weather: $WW, $W1, $W2
Cloud: $NH (Cover, oktas), $CL (Low Type), $CM (Mid Type), $CH (High Type), (Base (m): $CLOUD_H)
EOF
};
};
exit;
###########################################
# Utility routine
###########################################
# Split up GTS SYNOP (AAXX, BBXX) and BUOY messages
#
# Input: string of messages, as received over GTS
# Output: array of messages, each with own header
#
# Note: short messages (<=8 chars) aren't included in the output; this
# means that the terminating "NNNN" is also not returned.
# Note: junk characters are now allowed
sub split_gts_synop {
my($text)=@_;
my($line,@line,$M,@Messages,$MESSAGES,$TYPE);
@text=split(/NNNN/,"\n".$text);
if ($DEBUG) { print "Got ",$#text+1," messages\n" };
while ($line=shift @text) {
if ($DEBUG>1) { print "Line: $line\n" };
if ($line=~/\n(AAXX|BBXX|ZZYY)/) {
$TYPE=$1;
# AAXX's often come in groups, with the date shared betweeen them. Need to split it off the first
if ($DEBUG>1) { print "Type: $TYPE\n" };
if ($TYPE eq "AAXX"
{
@line=split(" ",$');
$DATE=shift @line;
# Check that the date looks vaguely OK, otherwise junk the line
if (length($DATE) != 5) { $line=" " } else { $line=join(" ",@line) };
$DATE.=" "; $TYPE.=" ";
} else {
$line=$TYPE." ".$';
$DATE=""; $TYPE="";
};
@Messages=split(/=/,$line);
foreach $M (@Messages) {
$M=~s/^\s*//;
if ( (length($M) > 8) && $M !~ /[^\s\w\/\.]/ ) {
push(@MESSAGES,$TYPE.$DATE.$M)
}
};
};
};
return @MESSAGES;
};
###########################################
# Actual decode routine
###########################################
sub decode_synop {
my(@GROUPS)=split(' ',$_[0]);
my($TYPE,$NAME,$YEAR,$MON,$DAY,$HOUR,$LA,$Q,$LO,$T,$TOTAL_CLOUD,$DIR,$SPD,$IW,%IWs,$ICE,$DEWT,$PSTA);
my($PTND,$PTND_code,$PTND_value,$PPN,$PPN_code,$PPN_value);
my($H,$Ir,$Ix,$CLOUD_H,$VV);
my($WW,$W1,$W2,$WEATHER);
my($NH,$CL,$CM,$CH,$CLOUD);
my($V,@VALUES);
# Get type - AAXX or BBXX. Return null if not one of the two.
$TYPE=shift @GROUPS;
if ($TYPE !~ /^(AAXX|BBXX)$/) { return '' };
# If this is a land group, exchange the first two groups
if ($TYPE eq "AAXX" {@GROUPS[0,1]=@GROUPS[1,0]};
# Get identifier
$NAME=shift @GROUPS;
# Now, check that the rest of the message (up to 333/444/555/ICE) consists of 5 figure groups
# Groups that aren't 5 figures get deleted.
for ($I=0; $I<$#GROUPS; $I++) {
last if ($GROUPS[$I] =~ /333|444|555|ICE/);
if (length($GROUPS[$I]) != 5) { splice(@GROUPS,$I,1) }
};
# Get date (day and hour)
$DAY=substr($GROUPS[0],0,2);
$IW=substr($GROUPS[0],4,1);
$HOUR=substr(shift @GROUPS,2,2);
%IWs=(0, "m/s -> kts (estimated)", 1, "m/s -> kts (anemometer)", 3, "kts (estimated)", 4, "kts (anemometer)"
$IW=$IWs{$IW};
# Now guess the year and month, based on the current date.
($MON,$YEAR)=guess_mon_year($DAY);
# Only get lat, lon if a ship
if ($TYPE eq "BBXX" {
# Get latitude. Should be headed by "99" - return null if not
$LA=shift @GROUPS;
if (substr($LA,0,2) ne '99') { return '' };
$LA=substr($LA,2,3)/10.;
# Get longitude. First char is quadrant: 5 for SW, 3 for SE
$Q=substr($GROUPS[0],0,1);
$LO=substr(shift @GROUPS,1,4)/10.;
if ($Q == 3 || $Q == 5) {$LA=-$LA};
if ($Q == 5 || $Q == 7) {$LO=-$LO};
};
# iivVV
#
# Get i_r i_x h VV group
#
($Ir,$Ix,$CLOUD_H,$VV) = (shift(@GROUPS) =~ /(.)(.)(.)(..)/ );
# Ir (ppn presence)
# Ir == 3 means ppn omitted later *and is zero*
# Ir == something else mean ppn not available/reported later
if ($Ir eq "3" { $PPN_value=0 };
# Ix (station type/weather)
if ($Ir =~ /(1|2|3)/ ) {
$ST_TYPE="Manned"
} elsif ($Ir =~ /(4|5|6|7)/ ) {
$ST_TYPE="AWS"
} else {
$ST_TYPE="Unknown ($Ir)"
};
# h (cloud base height) (code table 1600)
if ($CLOUD_H =~ /\d/) { $CLOUD_H = (0,50,100,200,300,600,1000,1500,2000,2500)[$CLOUD_H] }
else { undef $CLOUD_H };
# Nddff
#
# Wind group. Note conversion to kts if in m/s based on IW (30/4/97)
#
if (!$GROUPS[0]) { return "" }; # WMC 20/11/97 - return null if no wind group
$GROUPS[0]=&check($GROUPS[0]);
$TOTAL_CLOUD=substr($GROUPS[0],0,1);
$DIR=10*substr($GROUPS[0],1,2);
if ($DIR == 990) {undef $DIR};
if ($DIR > 360) {$DIR.=" (really???)"};
$SPD=substr(shift @GROUPS,3,2);
if ($SPD !~ /\d{2}/) {undef $SPD};
if ($IW =~ /m\/s/) {$SPD=int($SPD*10/0.5148+0.5)/10.}
# 1sTTT
#
# Get temperature (checking leading digit is a 1)
#
($GROUP_ID,$S,$T)=(shift(@GROUPS) =~ /(.)(.)(...)/);
if ($GROUP_ID eq "1" {
if ($T =~ /\d{3}/ and $S =~ /0|1/) {
$T=$T/10.;
if ($S) { $T=-$T }
} else {
undef $T
}
} else {
unshift(@GROUPS,$GROUP_ID.$S.$T); undef $T
};
# 2sTTT
#
# Get dew temperature (checking leading digit is a 2. If it isn't, return it to the list)
# If S (sign) is not 0 or 1 (it could be 9, for relative humidity) then throw DEWT away.
#
($GROUP_ID,$S,$DEWT)=(shift(@GROUPS) =~ /(.)(.)(...)/);
if ($GROUP_ID eq "2" {
if ($DEWT =~ /\d{3}/ and $S =~ /0|1/) {
$DEWT=$DEWT/10.;
if ($S) { $DEWT=-$DEWT }
} else {
undef $DEWT
}
} else {
unshift(@GROUPS,$GROUP_ID.$S.$DEWT); undef $DEWT
};
# 3PPPP
#
# Get station pressure group (checking leading digit is a 3. If it isn't, return it to the list)
#
$PSTA=shift @GROUPS;
if (substr($PSTA,0,1) eq "3" { $PSTA=substr($PSTA,1,4)/10.; if ($PSTA<400) { $PSTA+=1000 } }
else { unshift(@GROUPS,$PSTA); undef $PSTA };
# 4PPPP
#
# Get MSLP pressure group (4) (checking leading digit is a 4. If it isn't, return it to the list)
#
$PRED=shift @GROUPS;
if (substr($PRED,0,1) eq "4" {
$PRED=substr($PRED,1,4);
if ($PRED !~ /\d{4}/) {
undef $PRED
} else {
$PRED/=10.;
if ($PRED<400) { $PRED+=1000 }
}
} else {
unshift(@GROUPS,$PRED); undef $PRED
};
# 5aPPP
#
# Get P tendency group (5)
#
$PTND=shift @GROUPS;
if (substr($PTND,0,1) eq "5" {
$PTND_code=substr($PTND,1,1)." (code table 200)";
$PTND_value=substr($PTND,2,3);
if ($PTND_value !~ /\//) {$PTND_value/=10.};
} else { unshift(@GROUPS,$PTND); undef $PTND };
# 6RRRt
#
# Get ppn group (6)
#
$PPN=shift @GROUPS;
if (substr($PPN,0,1) eq "6" {
$PPN_code=substr($PPN,4,1)." (code table 3590)";
$PPN_value=substr($PPN,1,3);
if ($PPN_value !~ /\//) {
if ($PPN_value == 990) { $PPN_value="trace" } elsif ($PPN_value > 990) {
$PPN_value=($PPN_value-990)/10.
}
};
} else { unshift(@GROUPS,$PPN); undef $PPN };
# 7wwWW
#
# Get weather type groups
#
# Ix codes for whether these groups are supposed to be present or not.
# However, since we've got no-where to complain to there's not a lot
# of point checking.
($GROUP_ID,$WEATHER) = (shift(@GROUPS) =~ /(.)(....)/ );
if ($GROUP_ID eq "7" {
($WW,$W1,$W2) = ($WEATHER =~ /(..)(.)(.)/ );
} else { unshift(@GROUPS,$GROUP_ID.$WEATHER); undef $WEATHER };
# 8NCCC
#
# Cloud group - 8NhClCmCh
#
($GROUP_ID,$CLOUD) = (shift(@GROUPS) =~ /(.)(....)/ );
if ($GROUP_ID eq "8" {
($NH,$CL,$CM,$CH) = ($CLOUD =~ /(.)(.)(.)(.)/ );
} else { unshift(@GROUPS,$GROUP_ID.$CLOUD); undef $CLOUD };
# End - see if we can find an ICE group (we'll fail if this is a land one! (and indeed for most ships))
while ($GROUP=shift @GROUPS) {
if ($GROUP eq "ICE" { $ICE=join(" ",@GROUPS); undef @GROUPS;
# Lets try to decode the ICE group a bit (if it doesn't look like plain text)
if (length($ICE) == 5 and $ICE !~ /[^\d\/]/) {
local @Ices = ( $ICE=~/(.)(.)(.).(.)/ );
for (@Ices) { s#/#10# };
$Ices[0]='Concentration: '.('No ice in sight','in open lead or fast ice','uniform; < 3/10','uniform; 4/10 to 6/10','uniform 7/10 to 8/10','uniform 9/10+','varied; low','varied','varied; high','varied; very high','unable to report')[$Ices[0]];
$Ices[1]='Thickness: '.('new ice','nilas < 10cm','young 10-30cm','mostly new','mostly thin 1st-year','1st-year 30-70cm','mostly 1st-year 70-120cm','1st-year medium & thick','mostly baby oil','mostly old','unable to report')[$Ices[1]];
$GB='growlers/bergy bits';
$Ices[2]='Type: '.('None','1-5 bergs','6-10 bergs','11-20 bergs',"<=10 $GB","1-5 bergs + $GB","6-10 bergs + $GB","11-20 bergs + $GB","20+ bergs + $GB - nav. hazard",'unable to report')[$Ices[2]];
$Ices[3]='Situation/Trend: '.('open water; ice in sight','easy penetration; improving','easy penetration','easy penetration; worsening','hard penetration; improving','hard penetration','hard penetration; ice forming; worsening','hard penetration; ice pressure; worsening','hard penetration; heavy ice pressure; worsening','beset; worsening','unable to report')[$Ices[3]];
$ICE=join(" ",@Ices);
};
};
};
# return
@VALUES=($NAME,$YEAR,$MON,$DAY,$HOUR,$LA,$LO,$T,$DIR,$SPD,$IW,$TOTAL_CLOUD,$ICE,$DEWT,$PSTA,$PRED,$PTND_code,$PTND_value,$PPN_code,$PPN_value,$ST_TYPE,$WW,$W1,$W2,$NH,$CL,$CM,$CH,$CLOUD_H);
foreach $V (@VALUES) { if ( ($V=~/^\/+$/) || (!$V && $V !~ /0/) ) { $V="null" } };
return @VALUES
};
# Check that a group has 5 characters, all digits or "/"'s
# IF the group is null, let that pass
sub check {
local($_)=@_;
return $_ if (!$_);
if ((length($_) != 5) || /[^\d\/]/) {
if ($DEBUG) { print "Invalid group: expected 5 digits or \"\/\"'s: $_" };
$_="/////";
if ($DEBUG) { print " changed to: $_\n" };
};
return $_;
};
###########################################
# Utility routine
###########################################
sub guess_mon_year {
# Get parameter: day
local($day)=@_;
# Get the current day, month, year
local($sec,$min,$hour,$DAY,$MON,$YEAR,$junk)=localtime(time());
$MON=$MON+1;
# Maybe pretend...
if ($PRETEND_YEAR_IS) { $YEAR=$PRETEND_YEAR_IS };
if ($PRETEND_MONTH_IS) { $MON=$PRETEND_MONTH_IS };
if ($PRETEND_DAY_IS) { $DAY=$PRETEND_DAY_IS };
# Maybe need previous month, year
if ($day > $DAY+1) { $MON-- };
if ($MON ==0) { $MON=12; $YEAR-- };
return ($MON,$YEAR)
};
<!--#exec cgi="weather/cgi-bin/synops.pl"-->
But it is not doing anything the autor of the script told me the script is not a CGI script. It is just a command-line (as in unix/linux shell prompt) script. I hope you can get it to work. And are able to add the option for getting the synoptic file from the internet site
This is the script
#!/usr/bin/perl
# Example of input format:
#AAXX 17014
#94102 NIL=
#94200 NIL=
#94203 NIL=
#94211 NIL=
#94212 NIL=
#94214 31997 50000 10358 20214 30081 40099 51008 70410 85260=
#NNNN
#SMAA10 DEMS 170000
#AAXX 17004
#89514 42998 11824 11028 49903 52021 80002 333 10028 21030
#81075=
#NNNN
# Read in all input files, and split into messages
@text=<>;
@text=split_gts_synop(join("",@text));
# Go through the messages and decode the AAXX ones.
foreach $REPORT (@text) {
# Decode if AAXX
if ($REPORT=~/^AAXX/) {
($NAME,$YEAR,$MON,$DAY,$HOUR,$LA,$LO,$T,$DIR,$SPD,$IW,$CLOUD,$ICE,$DEWT,$PSTA,$PRED,$PTND_code,$PTND_value,$PPN_code,$PPN_value,$ST_TYPE,$WW,$W1,$W2,$NH,$CL,$CM,$CH,$CLOUD_H)
= decode_synop($REPORT);
# Output
print <<EOF;
Report:
$REPORT
Decoded:
Ident: $NAME; Date: $YEAR/$MON/$DAY:$HOUR; Location: $LA (Lat), $LO (Long); Type: $ST_TYPE
Pressure: $PSTA (station) / $PRED (MSLP) / $PTND_value [$PTND_code] (P Tend)
Temperature: $T / $DEWT (Dew Temp)
Wind: $DIR (Direction) / $SPD (speed)
Precipitation: $PPN_value [$PPN_code]
Weather: $WW, $W1, $W2
Cloud: $NH (Cover, oktas), $CL (Low Type), $CM (Mid Type), $CH (High Type), (Base (m): $CLOUD_H)
EOF
};
};
exit;
###########################################
# Utility routine
###########################################
# Split up GTS SYNOP (AAXX, BBXX) and BUOY messages
#
# Input: string of messages, as received over GTS
# Output: array of messages, each with own header
#
# Note: short messages (<=8 chars) aren't included in the output; this
# means that the terminating "NNNN" is also not returned.
# Note: junk characters are now allowed
sub split_gts_synop {
my($text)=@_;
my($line,@line,$M,@Messages,$MESSAGES,$TYPE);
@text=split(/NNNN/,"\n".$text);
if ($DEBUG) { print "Got ",$#text+1," messages\n" };
while ($line=shift @text) {
if ($DEBUG>1) { print "Line: $line\n" };
if ($line=~/\n(AAXX|BBXX|ZZYY)/) {
$TYPE=$1;
# AAXX's often come in groups, with the date shared betweeen them. Need to split it off the first
if ($DEBUG>1) { print "Type: $TYPE\n" };
if ($TYPE eq "AAXX"
{@line=split(" ",$');
$DATE=shift @line;
# Check that the date looks vaguely OK, otherwise junk the line
if (length($DATE) != 5) { $line=" " } else { $line=join(" ",@line) };
$DATE.=" "; $TYPE.=" ";
} else {
$line=$TYPE." ".$';
$DATE=""; $TYPE="";
};
@Messages=split(/=/,$line);
foreach $M (@Messages) {
$M=~s/^\s*//;
if ( (length($M) > 8) && $M !~ /[^\s\w\/\.]/ ) {
push(@MESSAGES,$TYPE.$DATE.$M)
}
};
};
};
return @MESSAGES;
};
###########################################
# Actual decode routine
###########################################
sub decode_synop {
my(@GROUPS)=split(' ',$_[0]);
my($TYPE,$NAME,$YEAR,$MON,$DAY,$HOUR,$LA,$Q,$LO,$T,$TOTAL_CLOUD,$DIR,$SPD,$IW,%IWs,$ICE,$DEWT,$PSTA);
my($PTND,$PTND_code,$PTND_value,$PPN,$PPN_code,$PPN_value);
my($H,$Ir,$Ix,$CLOUD_H,$VV);
my($WW,$W1,$W2,$WEATHER);
my($NH,$CL,$CM,$CH,$CLOUD);
my($V,@VALUES);
# Get type - AAXX or BBXX. Return null if not one of the two.
$TYPE=shift @GROUPS;
if ($TYPE !~ /^(AAXX|BBXX)$/) { return '' };
# If this is a land group, exchange the first two groups
if ($TYPE eq "AAXX"
{@GROUPS[0,1]=@GROUPS[1,0]};# Get identifier
$NAME=shift @GROUPS;
# Now, check that the rest of the message (up to 333/444/555/ICE) consists of 5 figure groups
# Groups that aren't 5 figures get deleted.
for ($I=0; $I<$#GROUPS; $I++) {
last if ($GROUPS[$I] =~ /333|444|555|ICE/);
if (length($GROUPS[$I]) != 5) { splice(@GROUPS,$I,1) }
};
# Get date (day and hour)
$DAY=substr($GROUPS[0],0,2);
$IW=substr($GROUPS[0],4,1);
$HOUR=substr(shift @GROUPS,2,2);
%IWs=(0, "m/s -> kts (estimated)", 1, "m/s -> kts (anemometer)", 3, "kts (estimated)", 4, "kts (anemometer)"
;$IW=$IWs{$IW};
# Now guess the year and month, based on the current date.
($MON,$YEAR)=guess_mon_year($DAY);
# Only get lat, lon if a ship
if ($TYPE eq "BBXX"
{# Get latitude. Should be headed by "99" - return null if not
$LA=shift @GROUPS;
if (substr($LA,0,2) ne '99') { return '' };
$LA=substr($LA,2,3)/10.;
# Get longitude. First char is quadrant: 5 for SW, 3 for SE
$Q=substr($GROUPS[0],0,1);
$LO=substr(shift @GROUPS,1,4)/10.;
if ($Q == 3 || $Q == 5) {$LA=-$LA};
if ($Q == 5 || $Q == 7) {$LO=-$LO};
};
# iivVV
#
# Get i_r i_x h VV group
#
($Ir,$Ix,$CLOUD_H,$VV) = (shift(@GROUPS) =~ /(.)(.)(.)(..)/ );
# Ir (ppn presence)
# Ir == 3 means ppn omitted later *and is zero*
# Ir == something else mean ppn not available/reported later
if ($Ir eq "3"
{ $PPN_value=0 };# Ix (station type/weather)
if ($Ir =~ /(1|2|3)/ ) {
$ST_TYPE="Manned"
} elsif ($Ir =~ /(4|5|6|7)/ ) {
$ST_TYPE="AWS"
} else {
$ST_TYPE="Unknown ($Ir)"
};
# h (cloud base height) (code table 1600)
if ($CLOUD_H =~ /\d/) { $CLOUD_H = (0,50,100,200,300,600,1000,1500,2000,2500)[$CLOUD_H] }
else { undef $CLOUD_H };
# Nddff
#
# Wind group. Note conversion to kts if in m/s based on IW (30/4/97)
#
if (!$GROUPS[0]) { return "" }; # WMC 20/11/97 - return null if no wind group
$GROUPS[0]=&check($GROUPS[0]);
$TOTAL_CLOUD=substr($GROUPS[0],0,1);
$DIR=10*substr($GROUPS[0],1,2);
if ($DIR == 990) {undef $DIR};
if ($DIR > 360) {$DIR.=" (really???)"};
$SPD=substr(shift @GROUPS,3,2);
if ($SPD !~ /\d{2}/) {undef $SPD};
if ($IW =~ /m\/s/) {$SPD=int($SPD*10/0.5148+0.5)/10.}
# 1sTTT
#
# Get temperature (checking leading digit is a 1)
#
($GROUP_ID,$S,$T)=(shift(@GROUPS) =~ /(.)(.)(...)/);
if ($GROUP_ID eq "1"
{if ($T =~ /\d{3}/ and $S =~ /0|1/) {
$T=$T/10.;
if ($S) { $T=-$T }
} else {
undef $T
}
} else {
unshift(@GROUPS,$GROUP_ID.$S.$T); undef $T
};
# 2sTTT
#
# Get dew temperature (checking leading digit is a 2. If it isn't, return it to the list)
# If S (sign) is not 0 or 1 (it could be 9, for relative humidity) then throw DEWT away.
#
($GROUP_ID,$S,$DEWT)=(shift(@GROUPS) =~ /(.)(.)(...)/);
if ($GROUP_ID eq "2"
{if ($DEWT =~ /\d{3}/ and $S =~ /0|1/) {
$DEWT=$DEWT/10.;
if ($S) { $DEWT=-$DEWT }
} else {
undef $DEWT
}
} else {
unshift(@GROUPS,$GROUP_ID.$S.$DEWT); undef $DEWT
};
# 3PPPP
#
# Get station pressure group (checking leading digit is a 3. If it isn't, return it to the list)
#
$PSTA=shift @GROUPS;
if (substr($PSTA,0,1) eq "3"
{ $PSTA=substr($PSTA,1,4)/10.; if ($PSTA<400) { $PSTA+=1000 } }else { unshift(@GROUPS,$PSTA); undef $PSTA };
# 4PPPP
#
# Get MSLP pressure group (4) (checking leading digit is a 4. If it isn't, return it to the list)
#
$PRED=shift @GROUPS;
if (substr($PRED,0,1) eq "4"
{$PRED=substr($PRED,1,4);
if ($PRED !~ /\d{4}/) {
undef $PRED
} else {
$PRED/=10.;
if ($PRED<400) { $PRED+=1000 }
}
} else {
unshift(@GROUPS,$PRED); undef $PRED
};
# 5aPPP
#
# Get P tendency group (5)
#
$PTND=shift @GROUPS;
if (substr($PTND,0,1) eq "5"
{ $PTND_code=substr($PTND,1,1)." (code table 200)";
$PTND_value=substr($PTND,2,3);
if ($PTND_value !~ /\//) {$PTND_value/=10.};
} else { unshift(@GROUPS,$PTND); undef $PTND };
# 6RRRt
#
# Get ppn group (6)
#
$PPN=shift @GROUPS;
if (substr($PPN,0,1) eq "6"
{$PPN_code=substr($PPN,4,1)." (code table 3590)";
$PPN_value=substr($PPN,1,3);
if ($PPN_value !~ /\//) {
if ($PPN_value == 990) { $PPN_value="trace" } elsif ($PPN_value > 990) {
$PPN_value=($PPN_value-990)/10.
}
};
} else { unshift(@GROUPS,$PPN); undef $PPN };
# 7wwWW
#
# Get weather type groups
#
# Ix codes for whether these groups are supposed to be present or not.
# However, since we've got no-where to complain to there's not a lot
# of point checking.
($GROUP_ID,$WEATHER) = (shift(@GROUPS) =~ /(.)(....)/ );
if ($GROUP_ID eq "7"
{($WW,$W1,$W2) = ($WEATHER =~ /(..)(.)(.)/ );
} else { unshift(@GROUPS,$GROUP_ID.$WEATHER); undef $WEATHER };
# 8NCCC
#
# Cloud group - 8NhClCmCh
#
($GROUP_ID,$CLOUD) = (shift(@GROUPS) =~ /(.)(....)/ );
if ($GROUP_ID eq "8"
{($NH,$CL,$CM,$CH) = ($CLOUD =~ /(.)(.)(.)(.)/ );
} else { unshift(@GROUPS,$GROUP_ID.$CLOUD); undef $CLOUD };
# End - see if we can find an ICE group (we'll fail if this is a land one! (and indeed for most ships))
while ($GROUP=shift @GROUPS) {
if ($GROUP eq "ICE"
{ $ICE=join(" ",@GROUPS); undef @GROUPS; # Lets try to decode the ICE group a bit (if it doesn't look like plain text)
if (length($ICE) == 5 and $ICE !~ /[^\d\/]/) {
local @Ices = ( $ICE=~/(.)(.)(.).(.)/ );
for (@Ices) { s#/#10# };
$Ices[0]='Concentration: '.('No ice in sight','in open lead or fast ice','uniform; < 3/10','uniform; 4/10 to 6/10','uniform 7/10 to 8/10','uniform 9/10+','varied; low','varied','varied; high','varied; very high','unable to report')[$Ices[0]];
$Ices[1]='Thickness: '.('new ice','nilas < 10cm','young 10-30cm','mostly new','mostly thin 1st-year','1st-year 30-70cm','mostly 1st-year 70-120cm','1st-year medium & thick','mostly baby oil','mostly old','unable to report')[$Ices[1]];
$GB='growlers/bergy bits';
$Ices[2]='Type: '.('None','1-5 bergs','6-10 bergs','11-20 bergs',"<=10 $GB","1-5 bergs + $GB","6-10 bergs + $GB","11-20 bergs + $GB","20+ bergs + $GB - nav. hazard",'unable to report')[$Ices[2]];
$Ices[3]='Situation/Trend: '.('open water; ice in sight','easy penetration; improving','easy penetration','easy penetration; worsening','hard penetration; improving','hard penetration','hard penetration; ice forming; worsening','hard penetration; ice pressure; worsening','hard penetration; heavy ice pressure; worsening','beset; worsening','unable to report')[$Ices[3]];
$ICE=join(" ",@Ices);
};
};
};
# return
@VALUES=($NAME,$YEAR,$MON,$DAY,$HOUR,$LA,$LO,$T,$DIR,$SPD,$IW,$TOTAL_CLOUD,$ICE,$DEWT,$PSTA,$PRED,$PTND_code,$PTND_value,$PPN_code,$PPN_value,$ST_TYPE,$WW,$W1,$W2,$NH,$CL,$CM,$CH,$CLOUD_H);
foreach $V (@VALUES) { if ( ($V=~/^\/+$/) || (!$V && $V !~ /0/) ) { $V="null" } };
return @VALUES
};
# Check that a group has 5 characters, all digits or "/"'s
# IF the group is null, let that pass
sub check {
local($_)=@_;
return $_ if (!$_);
if ((length($_) != 5) || /[^\d\/]/) {
if ($DEBUG) { print "Invalid group: expected 5 digits or \"\/\"'s: $_" };
$_="/////";
if ($DEBUG) { print " changed to: $_\n" };
};
return $_;
};
###########################################
# Utility routine
###########################################
sub guess_mon_year {
# Get parameter: day
local($day)=@_;
# Get the current day, month, year
local($sec,$min,$hour,$DAY,$MON,$YEAR,$junk)=localtime(time());
$MON=$MON+1;
# Maybe pretend...
if ($PRETEND_YEAR_IS) { $YEAR=$PRETEND_YEAR_IS };
if ($PRETEND_MONTH_IS) { $MON=$PRETEND_MONTH_IS };
if ($PRETEND_DAY_IS) { $DAY=$PRETEND_DAY_IS };
# Maybe need previous month, year
if ($day > $DAY+1) { $MON-- };
if ($MON ==0) { $MON=12; $YEAR-- };
return ($MON,$YEAR)
};
- Status