[26177] in Perl-Users-Digest
Perl-Users Digest, Issue: 8366 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon Aug 29 00:05:32 2005
Date: Sun, 28 Aug 2005 21:05:04 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Sun, 28 Aug 2005 Volume: 10 Number: 8366
Today's topics:
Calling Diff on Arrays <rblove@airmail.net>
Re: Calling Diff on Arrays <kevin@vaildc.net>
how check DBI version on the server? <xman@nospam.tv>
Re: how check DBI version on the server? <no@email.com>
Re: how check DBI version on the server? <xman@nospam.tv>
How to get "subroutine call depth watermark"? <socyl@987jk.com.invalid>
Problems with PerlMSI, part of ActiveState's Perl Devel <graham@letsgouk.com>
Re: Problems with PerlMSI, part of ActiveState's Perl D <graham@letsgouk.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Mon, 29 Aug 2005 01:22:55 -0000
From: Robert Love <rblove@airmail.net>
Subject: Calling Diff on Arrays
Message-Id: <20050828202318480-0500@news.airmail.net>
I can read in two text files into arrays of lines, manipulate and sort
the contents. I then want to pass the arrays to diff and manipulate and
print the results of the diff. I have it working using temporary files
that I write the arrays into. My question is how do I do this directly,
without writing to temporary files?
What I have now looks like:
@results = `diff tmp1 tmp2`;
I have read FAQ 4.xx and that is NOT what I want. All tips & advice
appreciated.
------------------------------
Date: Mon, 29 Aug 2005 02:52:20 GMT
From: Kevin Michael Vail <kevin@vaildc.net>
Subject: Re: Calling Diff on Arrays
Message-Id: <kevin-D49290.22522128082005@news.verizon.net>
In article <20050828202318480-0500@news.airmail.net>,
Robert Love <rblove@airmail.net> wrote:
> I can read in two text files into arrays of lines, manipulate and sort
> the contents. I then want to pass the arrays to diff and manipulate and
> print the results of the diff. I have it working using temporary files
> that I write the arrays into. My question is how do I do this directly,
> without writing to temporary files?
>
> What I have now looks like:
>
> @results = `diff tmp1 tmp2`;
>
> I have read FAQ 4.xx and that is NOT what I want. All tips & advice
> appreciated.
Algorithm::Diff
## assume FILE1 and FILE2 are opened to two text files
my @array1 = <FILE1>;
my @array2 = <FILE2>;
my $diff = Algorithm::Diff::new(\@array1, \@array2);
From there you can do almost anything, see the perldoc for details.
--
Kevin Michael Vail | a billion stars go spinning through the night,
kevin@vaildc.net | blazing high above your head.
. . . . . . . . . | But _in_ you is the presence that
. . . . . . . . | will be, when all the stars are dead.
. . . . . . . . . | (Rainer Maria Rilke)
------------------------------
Date: Sun, 28 Aug 2005 21:11:29 +0200
From: "xman" <xman@nospam.tv>
Subject: how check DBI version on the server?
Message-Id: <det28k$puq$1@ss405.t-com.hr>
how check DBI version on the server?
------------------------------
Date: Sun, 28 Aug 2005 20:18:06 +0100
From: Brian Wakem <no@email.com>
Subject: Re: how check DBI version on the server?
Message-Id: <3negveF15j70U1@individual.net>
xman wrote:
> how check DBI version on the server?
perl -MDBI -e 'print "$DBI::VERSION\n"'
--
Brian Wakem
Email: http://homepage.ntlworld.com/b.wakem/myemail.png
------------------------------
Date: Sun, 28 Aug 2005 21:28:38 +0200
From: "xman" <xman@nospam.tv>
Subject: Re: how check DBI version on the server?
Message-Id: <det38q$rom$1@ss405.t-com.hr>
thanks
------------------------------
Date: Sun, 28 Aug 2005 21:16:02 +0000 (UTC)
From: kj <socyl@987jk.com.invalid>
Subject: How to get "subroutine call depth watermark"?
Message-Id: <det9ii$gt7$1@reader2.panix.com>
Is there a way for me to determine the "subroutine call depth
watermark" for a particular run of a Perl program? By this I mean
the greatest depth of subroutine calls attained by the program
during its execution.
A second best would be a similar watermark for the size of the perl
argument stack.
I don't know much about how perl manages the space allocated to
its stacks, but if it never shrinks this space once it is allocated,
then a third best would be the amount of memory allocated to the
argument stack at the time the program terminates.
Thanks!
kj
P.S. By "depth" I mean the same as what the error message in the
*very contrived* example below means:
main::(-e:1): 42
DB<1> sub foo{ foo() }
DB<2> foo
main::foo((eval 4)[/opt/lib/perl5/5.8.3/perl5db.pl:619]:2):
2: sub foo{ foo() };
100 levels deep in subroutine calls!
--
NOTE: In my address everything before the first period is backwards;
and the last period, and everything after it, should be discarded.
------------------------------
Date: Sun, 28 Aug 2005 22:17:22 +0100
From: "Graham" <graham@letsgouk.com>
Subject: Problems with PerlMSI, part of ActiveState's Perl Development Kit 6.0
Message-Id: <43122b45.0@entanet>
I'm a newbie to ActiveState's PDK.I bought it for two products - PerlApp &
PerlMSI. PerlApp is fine, no worries, but Perl MSI seems a bit of a
shambles. First problem was that I had to edit some code within msiwiz.pl
just to get the thing to run. Then, when I run the script msiwiz.pl produces
and which is supposed to write the actual MSI installer database file, it
goes so far then says 'Can't call method "AddFile" on an undefined value at
C:\Program Files\ActiveState Dev Kit 6.0\lib\/MSI/Image.pm line 100'. I've
fooled around with inserting a few 'my's into Image.pm, but can't seem to
solve the problem.
ActiveState are a bit slow in providing support - anyone experienced this
problem before?
------------------------------
Date: Sun, 28 Aug 2005 22:25:07 +0100
From: "Graham" <graham@letsgouk.com>
Subject: Re: Problems with PerlMSI, part of ActiveState's Perl Development Kit 6.0
Message-Id: <43122d18.0@entanet>
Before folk ask me for it (and at the risk of infringing copyright), here is
Image.pm in full
package MSI::Image;
use strict;
use Carp;
use Cwd;
use MSI::File;
use MSI::Component;
use File::Find;
use Data::Dumper;
use Win32::Cabinet;
require 5.6.0;
our $COMPONENT_FILES = 'exe|dll|chm';
my $IMAGEROOT;
use constant DEFAULT_DIR_ROOT => 'TARGETDIR';
###############################################################################
#
# MSI::Image->new($imageRoot, [ $keyGUID ])
#
sub new {
my ($proto, $imageRoot, $keyGUID) = @_;
my $class = ref $proto || $proto;
my $self = bless {}, $class;
$self->{'KeyGUID'} = $keyGUID;
$self->{'Data'} = [];
$self->{'DirectoryList'} = {};
$self->{'ComponentList'} = {};
$self->{'FileList'} = {};
$self->{'DirectoryRoot'} = DEFAULT_DIR_ROOT;
$self->CreateImage($imageRoot) if $imageRoot;
return $self;
}
###############################################################################
#
# $self->CreateImage($imageRoot)
#
sub CreateImage {
my ($self, $imageRoot) = @_;
croak "Directory '$imageRoot' does not exist!" unless -d $imageRoot;
($self->{ImageRoot} = $imageRoot) =~ s#\\#/#g;
my $reap = sub {
my $ctx = $self;
my $ful_path = $File::Find::name;
(my $rel_path = $ful_path) =~ s#$ctx->{ImageRoot}/##;
return if m#^\.\.?$#;
if (-d $_) {
#rem $rel_path =~ m#.*?/?([^/]+)/?([^/]*)$#;
$rel_path =~ m/(.*)[\\\/](.*$)/;
my $parent = $1;
my $default = $2;
$parent = "\U$parent";
my $DirectoryKey = StrToUKey($rel_path);
if(not $default) {
$default = $rel_path;
$parent = DEFAULT_DIR_ROOT;
}
# Get short filename
if (length($default) > 8){
# my $short_name = Win32::GetShortPathName(scalar
Win32::GetFullPathName($ful_path));
my $short_name = Win32::GetShortPathName(scalar
Win32::GetFullPathName($default));
$short_name =~ s/.*[\\\/](.*)/$1/;
$default = $short_name . '|' . $default;
}
$parent =~ s/[^a-zA-Z0-9\.]/_/g;
$ctx->{DirectoryList}->{$rel_path} = {
Directory => $DirectoryKey,
Directory_Parent => $parent,
DefaultDir => $default
};
my $component = MSI::Component->new($rel_path);
$component->Directory($DirectoryKey);
$ctx->{ComponentList}->{$DirectoryKey} = $component;
$component->ComponentID($rel_path);
}elsif (-f $_) {
my $file = MSI::File->new($_, $rel_path);
(my $component_dir = $rel_path) =~ s#(.*)/.*#$1#;
my $DirectoryKey = StrToUKey($component_dir);
# Check if this file has one of our component extensions
if (m#\.($COMPONENT_FILES)$#i) {
my $ComponentKey = StrToKey($rel_path);
$file->Component($ComponentKey);
my $component = MSI::Component->new($rel_path);
$component->Directory($DirectoryKey);
$component->ComponentID($rel_path =~ s#^/##);
$component->KeyPath($ComponentKey);
$ctx->{ComponentList}->{$ComponentKey} = $component;
}else {
$ctx->{ComponentList}->{$DirectoryKey}->AddFile($file);
}
$ctx->{FileList}->{$rel_path} = $file;
}
else {
die 'What am I doing here?';
}
};
find($reap, $self->{'ImageRoot'});
}
###############################################################################
#
# $self->GetDirectory($directory_name)
#
sub GetDirectory {
my $self = shift;
my $path = shift;
croak "Directory '$path' does not exist in image!" unless exists
$self->{'DirectoryList'}->{$path};
return $self->{'DirectoryList'}->{$path};
}
###############################################################################
#
# $self->GetComponent($component_name)
#
sub GetComponent {
my $self = shift;
my $component_name = shift;
my $component_key = StrToKey($component_name);
my $component_ukey = StrToUKey($component_name);
if (exists $self->{ComponentList}->{$component_key}) {
return $self->{ComponentList}->{$component_key};
} elsif (exists $self->{ComponentList}->{$component_ukey}) {
return $self->{ComponentList}->{$component_ukey};
} else {
croak "Component '$component_name' does not exist in image!";
}
}
###############################################################################
#
# $self->GetFile($file_name)
#
sub GetFile {
my $self = shift;
my $path = shift;
croak "File '$path' does not exist in image!" unless exists
$self->{'FileList'}->{$path};
return $self->{'FileList'}->{$path};
}
###############################################################################
#
# $self->DirectoryList()
#
sub DirectoryList {
my $self = shift;
return map { $self->{DirectoryList}->{$_} } keys
%{$self->{DirectoryList}};
}
###############################################################################
#
# $self->ComponentList()
#
sub ComponentList {
my $self = shift;
return map { $self->{ComponentList}->{$_} } keys
%{$self->{ComponentList}};
}
###############################################################################
#
# $self->FileList()
#
sub FileList {
my $self = shift;
return map { $self->{FileList}->{$_} } keys %{$self->{FileList}};
}
###############################################################################
#
# $self->SetComponentFeature($name, $feature, [ $is_dir ], [ $recurse ])
#
sub SetComponentFeature {
my ($self, $name, $feature, $add, $recurse) = @_;
my $ComponentKey = StrToKey($name);
my $ComponentUKey = StrToUKey($name);
croak "Component '$name' does not exist in image!"
unless (exists $self->{ComponentList}->{$ComponentKey}
or exists $self->{ComponentList}->{$ComponentUKey}
);
if($recurse) {
foreach my $key (keys %{$self->{ComponentList}}) {
if($key =~ m#^$ComponentKey#
or $key =~ m#^$ComponentUKey#
) {
print $key, " => ", $feature, "\n";
$add or ($self->{ComponentList}->{$key}->{Features} = {});
$self->{ComponentList}->{$key}->{Features}->{$feature} = 1;
}
}
}
else {
if($add){#it is directory
$self->{ComponentList}->{$ComponentUKey}->{Features}->{$feature}
= 1;
}else{
$self->{ComponentList}->{$ComponentKey}->{Features} = {};
$self->{ComponentList}->{$ComponentKey}->{Features}->{$feature}
= 1;
}
}
}
###############################################################################
#
# $self->SetComponentAttributes($name, $attrs, [ $is_dir ], [ $recurse ])
#
sub SetComponentAttributes {
my ($self, $name, $attrs, $recurse) = @_;
croak "Component '$name' does not exist in image!"
unless exists $self->{ComponentList}->{$name};
if($recurse) {
foreach my $key (keys %{$self->ComponentList}) {
if($key =~ m#^$name#) {
$self->{ComponentList}->{$key}->Attributes($attrs);
}
}
}
else {
$self->{ComponentList}->{$name}->Attributes($attrs);
}
}
###############################################################################
#
# $self->SetFileComponent($name, $component)
#
sub SetFileComponent {
my ($self, $name, $component) = @_;
croak "Component '$component' does not exist in image!"
unless exists $self->{ComponentList}->{$name};
croak "File '$component' does not exist in image!"
unless exists $self->{ComponentList}->{$name};
$self->{FileList}->{$name}->Component($component);
}
###############################################################################
#
# $self->SetFileAttributes($name, $attrs, [ $is_dir ], [ $recurse ])
#
sub SetFileAttributes {
my ($self, $name, $attrs, $recurse) = @_;
croak "File '$name' does not exist in image!"
unless exists $self->{FileList}->{$name};
if($recurse) {
foreach my $key (keys %{$self->FileList}) {
if($key =~ m#^$name#) {
$self->{FileList}->{$key}->Attributes($attrs);
}
}
}
else {
$self->{FileList}->{$name}->Attributes($attrs);
}
}
sub MakeCabinet {
my ($self, $start_seq, $filename) = @_;
my $cabinet = Win32::Cabinet->new;
if(!$cabinet->Create('Foo', $filename, './')) {
croak "Error creating cabfile $filename!" if !$cabinet;
}
foreach my $fileid (keys %{$self->{FileList}}) {
my $file = $self->{FileList}->{$fileid};
$file->Sequence($start_seq++);
$cabinet->AddFile($self->{ImageRoot} . '/' . $file->PathName,
$file->File, 0)
or croak "Error adding ", $file->PathName, " to cabfile: $filename";
}
$cabinet->Write() or croak "Error writing cabfile $filename";
return $start_seq;
}
sub StrToKey{
# my $self = shift;
my $str = shift;
if(defined $str){$str =~ tr/
\\\/\-\+\*\&\#\$\@\(\)\{\}\[\];:'",<>?=~!/_/;}
return $str;
}
sub StrToUKey{
# my $self = shift;
my $str = shift;
if(defined $str){$str =~ tr/a-z
\\\/\-\+\*\&\#\$\@\(\)\{\}\[\];:'",<>?=~!/A-Z_/;}
return $str;
}
1;
__END__
my $image = MSI::Image->new('../../img', 'XXX555OOO');
$image->SetFileAttributes('Perl', 1024, 1);
print Data::Dumper->Dump( [$image] );
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>
Administrivia:
#The Perl-Users Digest is a retransmission of the USENET newsgroup
#comp.lang.perl.misc. For subscription or unsubscription requests, send
#the single line:
#
# subscribe perl-users
#or:
# unsubscribe perl-users
#
#to almanac@ruby.oce.orst.edu.
NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
#To request back copies (available for a week or so), send your request
#to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
#where x is the volume number and y is the issue number.
#For other requests pertaining to the digest, send mail to
#perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
#sending perl questions to the -request address, I don't have time to
#answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V10 Issue 8366
***************************************
