############################################# #!/usr/bin/perl # Attempt to copy registry permissions from one key to another use strict; use warnings; use Win32::TieRegistry qw( Delimiter / KEY_READ KEY_WRITE ); use Win32API::Registry; use Win32 qw( DACL_SECURITY_INFORMATION SACL_SECURITY_INFORMATION ); my $path = 'LMachine/Software/Classes'; my $key1 = 'opendocument.WriterDocument.1'; my $key2 = 'opendocument.WriterGlobalDocument.1'; my $r = $Registry->{"$path/$key1"}; print $r->{"/"},"\n"; my $sec; $r->RegGetKeySecurity( DACL_SECURITY_INFORMATION, $sec, [] ); # Only have read access on this - but can manually run regedit # and change permissions #my $r2 = $Registry->Open("$path/$key2", {Access => KEY_READ(), Delimiter=>"/"}); my $r2 = $Registry->{"$path/$key2"}; print $r2->{"/"},"\n"; $r2->RegSetKeySecurity( DACL_SECURITY_INFORMATION, $sec ); ############################################ # Non-Leaky anonymous recursive subs use Scalar::Util qw(weaken); my @arr = (1..100000); for (@arr) { my ($sub, $sub1); $sub1 = $sub = sub { my $num = shift; return $num + $sub->($num-1) if $num >0; return 0; }; weaken($sub); my $num = $sub->(5); print "$num\n"; unless ($_ % 1000) { print "$_: "; ; } } # Leaky anonymous recursive subs my @arr = (1..100000); for (@arr) { my $sub; $sub = sub { my $num = shift; return $num + $sub->($num-1) if $num >0; return 0; }; my $num = $sub->(5); unless ($_ % 1000) { print "$_: "; ; } } # Anonymous recursive sub my $sub; $sub = sub { my $num = shift; return $num + $sub->($num-1) if $num >0; return 0; }; print $sub->(5),"\n"; ########################### use strict; use warnings; my @arr; foo($arr[$#arr]); sub foo { 1; } ########################### #!/bin/ksh # Feel free to comment/criticize... # # Backup files before removing them. # Before using this script, # you must set environment variable "BAK" # to the directory in which you want to backup your files, # then you can use this script just like the rm command. # I currently have 'rm' aliased to this, and am seeing how # well it goes. [[ -z $BAK ]] && { print "$0: BAK variable not set"; exit 2; } [[ -d $BAK ]] || { print "$0: directory $BAK not found"; exit 2; } bkdir=$BAK/$(date '+%Y-%m-%d-%H:%M:%S') || exit 2 if [[ -d $bkdir ]] then ext=a while [[ -d $bkdir$ext ]] do ext=$(perl -e 'print ++$ARGV[0]' $ext) done bkdir=$bkdir$ext fi mkdir $bkdir || { print "$0: Can't create backup directory"; exit 2; } no_more_opts= for arg in "$@" do [[ $arg = '--' && -z $no_more_opts ]] && { no_more_opts=1; continue; } [[ $arg = -* && -z $no_more_opts ]] && continue # Check for ".." in path? [[ $arg = ?(*/)..?(/*) ]] && { print "$0: '..' not allowed in file path '$arg'" exit 2 } tmpdir=$bkdir # Do we need to create the directory path [[ $arg = ?*/* ]] && { path=${arg#/} path=${path%/*} tmpdir="$bkdir/$path" mkdir -p "$tmpdir" || { print "$0: Can't create backup directory $tmpdir" exit 2 } } opt="-h" [[ -d $arg ]] && opt="-R" cp $opt -- "$arg" "$tmpdir" done \rm "$@" print "Files backed up in $bkdir" ################################## # Oracle utility... # For a table, if there are any foreign keys # referring to a table's primary keys, then recursively # display the table's primary keys and foreign keys # referring to it. use strict; use warnings; use Getopt::Std; use DBI; my %opts; getopts('t:d:u:p:', \%opts) or die "Bad usage\n"; my $table = $opts{t} or die "No table\n"; my $db = $opts{d} || 'dbname'; my $user = $opts{u} || 'user'; my $passwd = $opts{p} || 'passwd'; $table = uc($table); my $dbh = DBI->connect("dbi:Oracle:$db", $user, $passwd, {RaiseError=>1}); my $sql = <prepare($sql); $sql = <prepare($sql); $sql = <prepare($sql); get_pk_info($table, 0); $dbh->disconnect; sub get_pk_info { my ($table, $level) = @_; my $pk_cnames = $dbh->selectcol_arrayref($name_h, {}, $table); for my $pk_cname (@$pk_cnames) { print "\t" x $level, "Table: $table\n" unless $level; my ($pk_table, @p_keys) = get_keys($pk_cname); my $fk_cnames = $dbh->selectcol_arrayref($r_name_h, {}, $pk_cname); my $first = 1; for my $fk_cname (@$fk_cnames) { if ($first) { print "\t" x $level, "Primary keys: @p_keys\n"; $first = 0; } my ($fk_table, @f_keys) = get_keys($fk_cname); print "\t" x $level, "FK table: $fk_table Fkeys: @f_keys\n"; get_pk_info($fk_table, $level+1); } } } sub get_keys { my $con_name = shift; my ($table, @names); $column_h->execute($con_name); $column_h->bind_columns(\my ($tmp_table, $pos, $col_name)); while ($column_h->fetch) { $table = $tmp_table unless defined $table; push @names, $col_name; } return $table, @names; }