Skip to content

Commit

Permalink
Perl code cleanup with perltidy
Browse files Browse the repository at this point in the history
  • Loading branch information
@ikluft
ikluft committed May 18, 2024
1 parent fa23777 commit ead2870
Show file tree
Hide file tree
Showing 4 changed files with 155 additions and 139 deletions.
70 changes: 36 additions & 34 deletions src/perl/bin/lon-tz.pl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,7 @@
use File::Basename;

# constants
Readonly::Scalar my $progname => basename( $0 );
Readonly::Scalar my $progname => basename($0);

# debug flag
my $debug = 0;
Expand Down Expand Up @@ -125,18 +125,18 @@ sub do_tz_op
my ( $opts_ref, $obj ) = @_;

my @fields;
if ( exists $opts_ref->{get}) {
if ( exists $opts_ref->{get} ) {
if ( ref $opts_ref->{get} eq "ARRAY" ) {
@fields = split( /,/x, join( ',', @{$opts_ref->{get}}));
@fields = split( /,/x, join( ',', @{ $opts_ref->{get} } ) );
} else {
croak "incorrect data type from --get parameter"
croak "incorrect data type from --get parameter";
}
} else {
@fields = qw(long_name);
}

# process requested fields
foreach my $field ( @fields ) {
foreach my $field (@fields) {
try {
say $obj->get($field);
} catch {
Expand All @@ -154,16 +154,9 @@ sub do_tz_op
sub main
{
my %opts;
my $res = GetOptions ( \%opts,
'debug',
'version|v',
'tzfile|tzdata',
'tzname:s',
'longitude:s',
'latitude:s',
'type:s',
'get:s@',
);
my $res =
GetOptions( \%opts, 'debug', 'version|v', 'tzfile|tzdata', 'tzname:s', 'longitude:s', 'latitude:s', 'type:s',
'get:s@', );

# check validity of arguments
if ( not $res ) {
Expand All @@ -174,66 +167,74 @@ sub main
if ( $opts{debug} // 0 ) {
$debug = 1;
}
if ( $debug ) {
if ($debug) {
my @out_opts;
foreach my $key (sort keys %opts) {
push @out_opts, "$key=".$opts{$key};
foreach my $key ( sort keys %opts ) {
push @out_opts, "$key=" . $opts{$key};
}
say "opts: ".join( " ", @out_opts );
say "opts: " . join( " ", @out_opts );
}

# display version
if ( $opts{version} // 0 ) {
say "version " . TimeZone::Solar->version() . " / Perl " . $Config{api_versionstring};
exit 0;
}

# generate tzfile
if ( $opts{tzfile} // 0 ) {
gen_tzfile();
exit 0;
}

# check mutually exclusive options
if (( exists $opts{tzname}) and ( exists $opts{longitude})) {
if ( ( exists $opts{tzname} ) and ( exists $opts{longitude} ) ) {
croak "mutually exclusive options tzname and longitude cannot be used at the same time";
}

# if tzname was provided, get parameters from it
my $result;
if ( exists $opts{tzname}) {
if ( exists $opts{tzname} ) {

# verify class is defined, making time zone string valid
my $classname = TimeZone::Solar::valid_tz_class( $opts{tzname});
my $classname = TimeZone::Solar::valid_tz_class( $opts{tzname} );
if ( not defined $classname ) {
croak "$opts{tzname} is not a valid solar/natural time zone name";
}

# run with the class name
$result = do_tz_op(\%opts, $classname->new());
$result = do_tz_op( \%opts, $classname->new() );
}

# if longitude was provided (latitude optional), generate time zone parameters
my $use_lon_tz = 0; # default to more common hour-based time zones rather than nice longitude-based tz
if ( exists $opts{type}) {
my $use_lon_tz = 0; # default to more common hour-based time zones rather than nice longitude-based tz
if ( exists $opts{type} ) {
if ( $opts{type} eq "hour" ) {
$use_lon_tz = 0;
} elsif ( $opts{type} eq "longitude" ) {
$use_lon_tz = 1;
} else {
croak "unrecognized time zone type '".$opts{type}."'";
croak "unrecognized time zone type '" . $opts{type} . "'";
}
}
if ( exists $opts{longitude}) {
if ( exists $opts{latitude}) {
$result = do_tz_op(\%opts, TimeZone::Solar->new( longitude => $opts{longitude},
latitude => $opts{latitude},
if ( exists $opts{longitude} ) {
if ( exists $opts{latitude} ) {
$result = do_tz_op(
\%opts,
TimeZone::Solar->new(
longitude => $opts{longitude},
latitude => $opts{latitude},
use_lon_tz => $use_lon_tz
));
)
);
} else {
$result = do_tz_op(\%opts, TimeZone::Solar->new( longitude => $opts{longitude},
$result = do_tz_op(
\%opts,
TimeZone::Solar->new(
longitude => $opts{longitude},
use_lon_tz => $use_lon_tz
));
)
);
}
}
return;
Expand All @@ -243,6 +244,7 @@ sub main
try {
main();
} catch {

# process any error/exception that we may have gotten
my $ex = $_;

Expand Down
25 changes: 13 additions & 12 deletions src/perl/lib/TimeZone/Solar.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,15 +28,15 @@ Readonly::Scalar my $debug_mode => ( $ENV{TZSOLAR_DEBUG} // 0 ) ? 1 : 0;

# accessor fields for implementation of CLI spec
Readonly::Hash my %field_code => (
longitude => sub { return $_[0]->longitude(); },
latitude => sub { return $_[0]->latitude(); },
name => sub { return $_[0]->name(); },
longitude => sub { return $_[0]->longitude(); },
latitude => sub { return $_[0]->latitude(); },
name => sub { return $_[0]->name(); },
short_name => sub { return $_[0]->short_name(); },
long_name => sub { return $_[0]->long_name(); },
offset => sub { return $_[0]->offset(); },
long_name => sub { return $_[0]->long_name(); },
offset => sub { return $_[0]->offset(); },
offset_min => sub { return $_[0]->offset_min(); },
offset_sec => sub { return $_[0]->offset_sec(); },
is_utc => sub { return $_[0]->is_utc(); },
is_utc => sub { return $_[0]->is_utc(); },
);

# constants
Expand Down Expand Up @@ -118,7 +118,8 @@ sub _tz_subclass

# for test coverage: if $opts{test_break_eval} is set, break the eval below
# under normal circumstances, %opts parameters should be omitted
my $result_cmd = (( $opts{test_break_eval} // 0 )
my $result_cmd = (
( $opts{test_break_eval} // 0 )
? "croak 'break due to test_break_eval'" # for testing we can force the eval to break
: "1" # normally the class definition returns 1
);
Expand Down Expand Up @@ -402,7 +403,7 @@ sub _tz_instance
# this also provides verification for external callers such as the CLI
sub valid_tz_class
{
my ( $classname ) = @_;
my ($classname) = @_;

# if a short name was provided, prepend the class prefix
my $tzsolar_class_prefix = _const("TZSOLAR_CLASS_PREFIX");
Expand All @@ -411,12 +412,12 @@ sub valid_tz_class
}

# valid tz class must be a sublass of TimeZone::Solar
if ( not $classname->isa(__PACKAGE__)) {
if ( not $classname->isa(__PACKAGE__) ) {
return;
}

# valid tz class must match the regular expression
my $tzsolar_zone_re = _const("TZSOLAR_ZONE_RE");
my $tzsolar_zone_re = _const("TZSOLAR_ZONE_RE");
if ( $classname !~ qr( $tzsolar_class_prefix $tzsolar_zone_re )x ) {
return;
}
Expand Down Expand Up @@ -521,14 +522,14 @@ sub offset_min
# throws exception if requested field name doesn't exist
sub get
{
my $self = shift;
my $self = shift;
my $field = shift;

# require valid field name
if ( not exists $field_code{$field} ) {
croak( __PACKAGE__ . ": non-existent field requested: $field" );
}
return $field_code{$field}->( $self );
return $field_code{$field}->($self);
}

#
Expand Down
9 changes: 3 additions & 6 deletions test/cli-test-perl.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,13 +10,10 @@ use File::Basename;
use FindBin qw($Bin);

# collect parameters
my $debug = ( $ENV{LONGITUDE_TZ_TEST_DEBUG} // 0 ) ? 1 : 0;
my $bin_dir = $Bin;
my $debug = ( $ENV{LONGITUDE_TZ_TEST_DEBUG} // 0 ) ? 1 : 0;
my $bin_dir = $Bin;
my $tree_root = dirname($bin_dir);
my $perl_path = $Config{perlpath};

# run black box test command
exec $perl_path $perl_path,
"$bin_dir/cli-test.pl",
( $debug ? "--debug" : ()),
"$tree_root/src/perl/bin/lon-tz.pl";
exec $perl_path $perl_path, "$bin_dir/cli-test.pl", ( $debug ? "--debug" : () ), "$tree_root/src/perl/bin/lon-tz.pl";
Loading

0 comments on commit ead2870

Please sign in to comment.