openSUSE Build Service

Overview Repositories Revisions Requests Users Attributes Meta

File dec2bin of Package geo-tools

#!/usr/bin/perl

# Copyright (C) 2010, 2011 Thorsten Kukuk
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# in Version 2 as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
# MA  02110-1301, USA.

=head1 NAME

bin2dec - binary to decimal converter
    bin2hex - binary to hexadecimal converter
    bin2oct - binary to octal converter
    dec2bin - decimal to binary converter
    dec2hex - decimal to hexadecimal converter
    dec2oct - decimal to octal converter
    hex2bin - hexadecimal to binary converter
    hex2dec - hexadecimal to decimal converter
    hex2oct - hexadecimal to octal converter
    oct2bin - octal to binary converter
    oct2dec - octal to decimal converter
    oct2hex - octal to hexadecimal converter

=head1 SYNOPSIS

=head1 OPTIONS

-p|--padding <number>  If output is shorter than <number> fillup
                           with zeros.

=head1 DESCRIPTION

This programs convert numbers from one numbering system into another
    one

=head1 OPTIONS

-h|-?	Help

=cut

use strict;
use warnings;
use File::Basename;
use Pod::Usage;

my $prog = basename($0);

#
# process command line arguments
#
use Getopt::Long;
my $help = 0;
my $man = 0;
my $padding = 0;

GetOptions('p|padding=i' => \$padding,
	   'man' => \$man,
           'help|h|?' => \$help) or pod2usage(2);
pod2usage(0) if $help;
pod2usage(-exitstatus => 0, -verbose => 2) if $man;

#if ($#ARGV < 0) {
#  pod2usage(2);
#}

## initialize op table
my %op_table = ("asc2bin" => \&asc2bin,
		"asc2dec" => \&asc2dec,
		"asc2hex" => \&asc2hex,
		"asc2oct" => \&asc2oct,
		"bin2asc" => \&bin2asc,
		"bin2dec" => \&bin2dec,
		"bin2hex" => \&bin2hex,
		"bin2oct" => \&bin2oct,
		"dec2asc" => \&dec2asc,
		"dec2bin" => \&dec2bin,
		"dec2hex" => \&dec2hex,
		"dec2oct" => \&dec2oct,
		"hex2bin" => \&hex2bin,
		"hex2dec" => \&hex2dec,
		"hex2oct" => \&hex2oct,
		"oct2bin" => \&oct2bin,
		"oct2dec" => \&oct2dec,
		"oct2hex" => \&oct2hex);

my $sub_ref = $op_table{$prog};

if (($#ARGV < 0) ||($#ARGV == 0 && $ARGV[0] eq "-")) {
  # read from tty
  while (<>) {
    my @numbers = split;
    foreach my $number (@numbers) {
      my $str = &{$sub_ref}($number);
      if ($padding > 0) {
        while (length($str) < $padding) {
          $str = "0".$str;
        }
      }
      print "$str\n";
    }
  }
} else {
  # read from commandline
  while (@ARGV) {
    my $str = &{$sub_ref}(shift);
    if ($padding > 0) {
      while (length($str) < $padding) {
	$str = "0".$str;
      }
    }
    print "$str\n";
  }
}
exit;

sub asc2dec { ord $_[0] }
sub asc2bin { dec2bin(asc2dec($_[0])) }
sub asc2hex { dec2hex(asc2dec($_[0])) }
sub asc2osc { dec2osc(asc2dec($_[0])) }
sub bin2asc { chr bin2dec($_[0]) }
sub bin2dec { unpack("N", pack("B32", substr("0" x 32 . $_[0], -32))) }
sub bin2hex {
  my $str = unpack("H8", pack("B32", substr("0" x 32 . $_[0], -32)));
  $str =~ s/^0+(?=[[:alnum:]])//;   # otherwise you'll get leading zeros
  uc $str; }
sub bin2oct {
  sprintf "%o", unpack("N", pack("B32", substr("0" x 32 . $_[0], -32))); }
sub dec2asc { chr $_[0] }
sub dec2bin { my $str = unpack("B32", pack("N", $_[0]));
	      $str =~ s/^0+(?=\d)//;   # otherwise you'll get leading zeros
	      return $str; }
sub dec2hex { my $str = unpack("H8", pack("N", $_[0]));
	      $str =~ s/^0+(?=[[:alnum:]])//;   # otherwise you'll get leading zeros
	      uc $str; }
sub dec2oct { sprintf "%o", $_[0]; }
sub hex2asc { chr hex2dec ($_[0]) }
sub hex2bin { my $str = unpack("B32", pack("N", hex $_[0]));
	      $str =~ s/^0+(?=\d)//;   # otherwise you'll get leading zeros
	      return $str; }
sub hex2dec { hex $_[0]; }
sub hex2oct { sprintf "%o", hex $_[0]; }
sub oct2asc { chr oct2dec($_[0]) }
sub oct2bin { my $str = unpack("B32", pack("N", oct $_[0]));
	      $str =~ s/^0+(?=\d)//;   # otherwise you'll get leading zeros
	      return $str; }
sub oct2dec { oct $_[0]; }
sub oct2hex { my $str = unpack("H8", pack("N", oct $_[0]));
	      $str =~ s/^0+(?=[[:alnum:]])//;   # otherwise you'll get leading zeros
	      uc $str; }

Places

File dec2bin of Package geo-tools

Places