decode_base64 perl

PHOTO

Sun Dec 27 2020 13:26:16 GMT+0000 (Coordinated Universal Time)

Saved by @lynx74br #perl

sub decode_base64 ($)
{
    local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123]
    #use integer;

    my $str = shift;
    $str =~ tr|A-Za-z0-9+=/||cd;            # remove non-base64 chars
    if (length($str) % 4) {
	require Carp;
	Carp::carp("Length of base64 data not a multiple of 4")
    }
    $str =~ s/=+$//;                        # remove padding
    $str =~ tr|A-Za-z0-9+/| -_|;            # convert to uuencoded format
    return "" unless length $str;

    ## I guess this could be written as
    #return unpack("u", join('', map( chr(32 + length($_)*3/4) . $_,
    #			$str =~ /(.{1,60})/gs) ) );
    ## but I do not like that...
    my $uustr = '';
    my ($i, $l);
    $l = length($str) - 60;
    for ($i = 0; $i <= $l; $i += 60) {
	$uustr .= "M" . substr($str, $i, 60);
    }
    $str = substr($str, $i);
    # and any leftover chars
    if ($str ne "") {
	$uustr .= chr(32 + length($str)*3/4) . $str;
    }
    return unpack ("u", $uustr);
}

Save snippets that work from anywhere online with our extensions

Available in the Chrome Web Store

Get Firefox Add-on

Get VS Code extension

Comments

More like this

sub crc16 {
   my ($string, $poly) = @_;
   my $crc = 0;
   for my $c ( unpack 'C*', $string ) {
      $crc ^= $c;
      for ( 0 .. 7 ) {
         my $carry = $crc & 1;
         $crc >>= 1;
         $crc ^= $poly if $carry;
      }
   }
   return $crc;
}

encode_base64 perl

sub encode_base64 ($;$)
{
    #use integer;

    my $eol = $_[1];
    $eol = "\n" unless defined $eol;

    my $res = pack("u", $_[0]);
    # Remove first character of each line, remove newlines
    $res =~ s/^.//mg;
    $res =~ s/\n//g;

    $res =~ tr|` -_|AA-Za-z0-9+/|;               # `# help emacs
    # fix padding at the end
    my $padding = (3 - length($_[0]) % 3) % 3;
    $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
    # break encoded string into lines of no more than 76 characters each
    if (length $eol) {
	$res =~ s/(.{1,76})/$1$eol/g;
    }
    return $res;
}

removetag xml html perl

sub removetag {
	my $_n = shift;
	my $_v = shift;
	$xml =~ s/(<$_n>).*(<\/$_n>)//g;
}

changetab xml html perl

sub changetab {
	my $_n = shift;
	my $_v = shift;
	$xml =~ s/(<$_n>).*(<\/$_n>)/\1$_v\2/g;
}

decode_base64 perl

sub decode_base64 ($)
{
    local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123]
    #use integer;

    my $str = shift;
    $str =~ tr|A-Za-z0-9+=/||cd;            # remove non-base64 chars
    if (length($str) % 4) {
	require Carp;
	Carp::carp("Length of base64 data not a multiple of 4")
    }
    $str =~ s/=+$//;                        # remove padding
    $str =~ tr|A-Za-z0-9+/| -_|;            # convert to uuencoded format
    return "" unless length $str;

    ## I guess this could be written as
    #return unpack("u", join('', map( chr(32 + length($_)*3/4) . $_,
    #			$str =~ /(.{1,60})/gs) ) );
    ## but I do not like that...
    my $uustr = '';
    my ($i, $l);
    $l = length($str) - 60;
    for ($i = 0; $i <= $l; $i += 60) {
	$uustr .= "M" . substr($str, $i, 60);
    }
    $str = substr($str, $i);
    # and any leftover chars
    if ($str ne "") {
	$uustr .= chr(32 + length($str)*3/4) . $str;
    }
    return unpack ("u", $uustr);
}

hash_to_json perl

sub hash_to_json {
	my $h = shift;
	use Data::Dumper;
	$Data::Dumper::Sortkeys = 1;
	$Data::Dumper::Pair = ":";
	$Data::Dumper::Indent = 0;
	$Data::Dumper::Terse = 1;
	$Data::Dumper::Useqq = '"';
	$_ = Dumper( $h );
	s/:undef/:null/g;
	print "$_\n";
}

my %json;
$json{status}='200';
$json{order}=1001;
$json{null}=undef;
$json{email}='test@test.com';
$json{data}[0]{id}=1;
$json{data}[0]{prod}='Notebook';
$json{data}[0]{value}=543.21;
$json{data}[1]{id}=2;
$json{data}[1]{prod}='Bad';
$json{data}[1]{value}=12.45;
hash_to_json(\%json);

DLookup(3) - Perform domain lookups on 2-letter and 3-letter TLDs

     use Net::DLookup;

     # Initialize Net::DLookup object
     my $dlu = Net::DLookup -> new;

     # Replace domain definitions from a file
     $dlu -> LoadTLD($file, 1);

     # Add domain definitions from a file
     $dlu -> LoadTLD($file, 0);

     # Check domain name validity and assign it to the object
     @errors = $dlu -> IsValid($domain);

     # Return availability
     @response = $dlu -> DoWhois(0);

     # Return availability and registrar information
     @response = $dlu -> DoWhois(1);

Заказ № 70000000050237784 от 24 декабря 2023 | Профиль | Авито

№ 7111111111111111111111 от 24 декабря 2023

#software #softwaredevelopment #webdesign #webdevelopment #usa #uk #technology #appdevelopment #appdesign #salonapp #spaapp #salonappdevelopment #fashion #newfashion #beautyparlour #itservices #webassembly #elixir #react.js #mysql #ruby #ios #objectivec #perl #actionscript3 #scheme #dart #haskell #java #kotlin #laravel

Salon App Development Company

https://technoderivation.com/salon-booking-app-development

Browse more snippets >>