[28759] in Perl-Users-Digest

home help back first fref pref prev next nref lref last post

Perl-Users Digest, Issue: 3 Volume: 11

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sat Jan 6 18:06:05 2007

Date: Sat, 6 Jan 2007 15:05:06 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)

Perl-Users Digest           Sat, 6 Jan 2007     Volume: 11 Number: 3

Today's topics:
        $r not work in mod_perl 2 jason.yfho@gmail.com
    Re: $r not work in mod_perl 2 <nobull67@gmail.com>
    Re: $r not work in mod_perl 2 <no@email.com>
    Re: gtk2 treeview and threads : custom sort while updat <zentara@highstream.net>
    Re: is Perl used in the Java middle-tier <asandstrom@accesswave.ca>
    Re: is Perl used in the Java middle-tier <rvtol+news@isolution.nl>
    Re: is Perl used in the Java middle-tier <tadmc@augustmail.com>
    Re: join array elements into a string <sisyphus1@nomail.afraid.org>
    Re: join array elements into a string <foobarbazqux@hotmail.com>
    Re: join array elements into a string <rvtol+news@isolution.nl>
    Re: join array elements into a string <jurgenex@hotmail.com>
    Re: Net::SSH installation problems - how do I force loc <sisyphus1@nomail.afraid.org>
    Re: Net::SSH installation problems - how do I force loc <stahl.karl@gmail.com>
        regex <lstouder@teksavvy.com>
    Re: regex <jurgenex@hotmail.com>
    Re: regex <john@castleamber.com>
    Re: regex <lstouder@teksavvy.com>
    Re: stalling server client program <deadpickle@gmail.com>
        substitutions in a large file <nospam@home.com>
    Re: substitutions in a large file <john@castleamber.com>
    Re: Unsecured scripts and site hacking? <shirsch@adelphia.net>
        Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)

----------------------------------------------------------------------

Date: 6 Jan 2007 02:45:04 -0800
From: jason.yfho@gmail.com
Subject: $r not work in mod_perl 2
Message-Id: <1168080304.393748.115260@42g2000cwt.googlegroups.com>

Dear All,

I installed mod_perl 2 (static mod) in my linux, however, seems the
perl script cannot invoke the mod_perl's function. anyone can give me
some ideaa on the problem? My purpose of using mod_perl is the get the
full header of all HTTP request to Apache. Thank you so much! Below is
the scenario:


System:
- Fedora 3
- Apache 2.2.3
- Perl 5.8.8


I added the following in httpd.conf:
PerlModule Apache2::Registry
<Directory "/usr/local/apache2/htdocs">
 ......
      Options Indexes FollowSymLinks ExecCGI
      PerlHandler Apache2::Registry
      PerlSendHeader On
 ......
</Directory>


When apache starts, the error_log shows:
[Sat Jan 06 18:43:54 2007] [notice] Apache/2.2.3 (Unix) mod_perl/2.0.3
Perl/v5.8.8 configured -- resuming normal operations


My perl script in "/usr/local/apache2/htdocs/test1.pl":
#!/usr/local/bin/perl5.8.8
use strict;
my $r = shift;
$r->print("It worked!!!\n");


The following error in error_log:
[Sat Jan 06 18:44:32 2007] [error] [client 192.168.1.35] Can't call
method "print" on an undefined value at
/usr/local/apache2/htdocs/test1.pl line 8.


Regards,
Jason



------------------------------

Date: 6 Jan 2007 09:19:01 -0800
From: "Brian McCauley" <nobull67@gmail.com>
Subject: Re: $r not work in mod_perl 2
Message-Id: <1168103941.870550.125500@v33g2000cwv.googlegroups.com>


jason.yfho@gmail.com wrote:

> I installed mod_perl 2 (static mod) in my linux, however, seems the
> perl script cannot invoke the mod_perl's function. anyone can give me
> some ideaa on the problem? My purpose of using mod_perl is the get the
> full header of all HTTP request to Apache. Thank you so much! Below is
> the scenario:
>
>
> System:
> - Fedora 3
> - Apache 2.2.3
> - Perl 5.8.8
>
>
> I added the following in httpd.conf:
> PerlModule Apache2::Registry
> <Directory "/usr/local/apache2/htdocs">
> ......
>       Options Indexes FollowSymLinks ExecCGI
>       PerlHandler Apache2::Registry
>       PerlSendHeader On
> ......
> </Directory>

My Apache2+mod_perl2 is a bit rusty but shouldn't there be a
"SetHandler perl-script" in there?

Wasn't Apache2::Registry renamed ModPerl::Registry?

> The following error in error_log:
> [Sat Jan 06 18:44:32 2007] [error] [client 192.168.1.35] Can't call
> method "print" on an undefined value at
> /usr/local/apache2/htdocs/test1.pl line 8.

I'd suggest printing out __PACKAGE__. If it says "main" then your
script is being executed via CGI not mod_perl.



------------------------------

Date: Sat, 06 Jan 2007 17:28:25 +0000
From: Brian Wakem <no@email.com>
Subject: Re: $r not work in mod_perl 2
Message-Id: <50a4h3F1bge4eU1@mid.individual.net>

Brian McCauley wrote:

> 
> jason.yfho@gmail.com wrote:
> 
>> I installed mod_perl 2 (static mod) in my linux, however, seems the
>> perl script cannot invoke the mod_perl's function. anyone can give me
>> some ideaa on the problem? My purpose of using mod_perl is the get the
>> full header of all HTTP request to Apache. Thank you so much! Below is
>> the scenario:
>>
>>
>> System:
>> - Fedora 3
>> - Apache 2.2.3
>> - Perl 5.8.8
>>
>>
>> I added the following in httpd.conf:
>> PerlModule Apache2::Registry
>> <Directory "/usr/local/apache2/htdocs">
>> ......
>>       Options Indexes FollowSymLinks ExecCGI
>>       PerlHandler Apache2::Registry
>>       PerlSendHeader On
>> ......
>> </Directory>
> 
> My Apache2+mod_perl2 is a bit rusty but shouldn't there be a
> "SetHandler perl-script" in there?
> 
> Wasn't Apache2::Registry renamed ModPerl::Registry?


I think you are right in both cases as by config file has this:

Alias /cgi-bin /usr/local/apache2/cgi-bin
<Directory /usr/local/apache2/cgi-bin>
    SetHandler perl-script
    PerlResponseHandler ModPerl::Registry
    PerlOptions +ParseHeaders
    Options -Indexes +ExecCGI +Includes +FollowSymLinks
    AllowOverride Authconfig
    Order allow,deny
    Allow from all
    Deny from [list of banned IPs]
</Directory>


-- 
Brian Wakem
Email: http://homepage.ntlworld.com/b.wakem/myemail.png


------------------------------

Date: Sat, 06 Jan 2007 10:38:45 -0500
From: zentara <zentara@highstream.net>
Subject: Re: gtk2 treeview and threads : custom sort while updating rows
Message-Id: <c9fvp2pc9kf7g6tk08fphahteld0f65b4e@4ax.com>

On 5 Jan 2007 04:22:05 -0800, erwan.barrier@gmail.com wrote:

>hello
>thanks for answering.

Your threaded code has many problems.

First:
Your threaded code example runs for me, so possibly
you need to upgrade to a more recent library version.
I'm using Glib-1.140 and Gtk2-1.140

Now for the real problems with your code.

1. It leaks memory every 500ms. You create a new thread for each
update_action call. The threads will not clean up after themselves,
and the memory they use will accumulate.  It is best to make 1 thread,
then reuse it, over and over.  Watch the memory usage of your script
as it runs.

2. I realize its just a simple example, but your threaded version has no
exit, if you hit the window manager's exit button, the threads keep on
going.

I really can't figure out what you are trying to accomplish, (although
I did ask for a trivial example). You seem to want to sort the
SimpleList in a thread?

You need to think about what you are trying to do. For example,
your first non-threaded example only "appears to sort" because you
are feeding it sequential numbers. Try this below, where I feed it
random numbers, it dosn't sort.

Typically in a threaded app, you create 1 thread, then reuse it, like:

my $thread = threads->create(\&start_action, $tree);
Glib::Timeout->add(500, \&update);   

where the thread sits there waiting, to do something like sort
the list and return it.

Another problem, is you are trying to access the set_sort_func from
the thread. This may work, or may not. You may be better off completely
encapsulating the SimpleList in a the thread, then use enter-leave to
add to it.

# Your original non-threaded dosn't work, just add a random number

#!/usr/bin/perl
use warnings;
use strict;
use Gtk2 qw/-init/;
use Gtk2::SimpleList;
use vars qw($count);

$count = 0;
my $win = Gtk2::Window->new;
$win ->signal_connect( 'destroy' => sub{exit} );
my $tree = Gtk2::SimpleList->new('test'    => 'int',);
$tree->get_column(0)->set_sort_column_id(0);
$tree->get_model->set_sort_func(0, \&sort_int);
$win->add($tree);

$win->show_all;
Glib::Timeout->add(500, \&update_action, $tree);

Gtk2->main;

sub update_action{
	my $tree = shift;
	push @{$tree->{data}}, rand $count++;
}

sub sort_int{
    my ($list, @iter) = @_;
    @iter = map {$_ = $list->get($_, 0);$_} @iter;
    return ($iter[0] <=> $iter[1]);
}
__END__


a possible way for you to do it, although the sorting
still dosn't work
 ( and I don't feel like figuring out why
right now... since I would do this in an entirely different fashion,
see example at very end). I like to use a more straightforward
(but probably more clunky) sleeping thread model, where
you create a thread, put it to sleep, then wake it up when
you want it to do something. This allows reuse, and no memory
gains. It usually always works properly, so that is why I use it.

For your sorting problem, I would pass the thread
all the list entries, tell it to start sorting, then return
a sorted list. I doubt if this will speed up things for you,
but it may help in a "blocking-the-gui" situation.

Threads are very tricky to use.  You might want to ask
this on the gtk2-perl maillist, but you will find that most
people will not devote much time to working out thread
problems, you are on your own.  The enter-leave thread
safety mechanism is still relatively new, so there may be
problems with the various higher-level-derived modules 
(like SimpleList) not being easy to use in threads.

# a possible model for you
############################################
#!/usr/bin/perl
use warnings;
use strict;
use Gtk2 qw/-init -threads-init/;
use Gtk2::SimpleList;
use Glib qw (TRUE FALSE);
use threads;
use threads::shared;
use vars qw($count $tree);
use GMeM;

die "Glib::Object thread safetly failed"
        unless Glib::Object->set_threadsafe (TRUE);

share($count);
$count = 0;
share($tree);

my $win = Gtk2::Window->new;
$win->signal_connect( 'destroy' => sub{exit} );
$win->set_default_size(300,200);
$win->set_position('center');

my $thread = threads->create(\&start_list);

$win->show_all;
Gtk2->main_iteration while Gtk2->events_pending;
Gtk2->main;

sub start_list{
  Gtk2::Gdk::Threads->enter;     
   my $tree = Gtk2::SimpleList->new('test'    => 'int',);
   $tree->get_column(0)->set_sort_column_id(0);

  # sorting func dosn't work for me
   $tree->get_model->set_sort_func(0, sub{
                 my ($list, @iter) = @_;
                 @iter = map {$_ = $list->get($_, 0);$_} @iter;
                 return ($iter[0] <=> $iter[1]);
     });
    

  $win->add($tree);
  $win->show_all;

  Glib::Timeout->add(500, sub{ push @{$tree->{data}}, rand $count++; });

  Gtk2->main_iteration while Gtk2->events_pending;
  Gtk2::Gdk::Threads->leave;
}
__END__
######################################################

# my typical thread setup
#####################################################
#!/usr/bin/perl
use warnings;
use strict;
use threads;
use threads::shared;
use Glib qw/TRUE FALSE/;
use Gtk2 '-init';

#setup shared hash
my %shash;
share(%shash); #will work for first level keys

$shash{'go'} = 0;
$shash{'data'} = '';
$shash{'work'} = '';
$shash{'die'} = 0;

#create 1 sleeping thread 
my $thread = threads->new(\&work);

my $window = Gtk2::Window->new('toplevel');
$window ->signal_connect( 'destroy' => \&exit_thr );
$window->set_border_width(10);
$window->set_size_request(300,300);

my $vbox = Gtk2::VBox->new( FALSE, 6 );
$window->add($vbox);
$vbox->set_border_width(2);

my $hbox= Gtk2::HBox->new( FALSE, 6 );
my $hbox1 = Gtk2::HBox->new( FALSE, 6 );
$vbox->pack_end($hbox,FALSE,FALSE,0);
$vbox->pack_end (Gtk2::HSeparator->new, FALSE, FALSE, 0);
$vbox->pack_end($hbox1,FALSE,FALSE,0);
$hbox->set_border_width(2);
$vbox->pack_end (Gtk2::HSeparator->new, FALSE, FALSE, 0);

my $ebutton = Gtk2::Button->new_from_stock('gtk-quit');
$hbox->pack_end( $ebutton, FALSE, FALSE, 0 );
$ebutton->signal_connect( clicked => \&exit_thr );

my $pbar = Gtk2::ProgressBar->new();
$pbar->set_pulse_step(.1);
$hbox->pack_start($pbar,1,1,0);

######################################################

my $tbutton = Gtk2::Button->new_with_label('Run Thread');
 $hbox1->pack_start($tbutton , 1, 1, 0 );
my $lconnect = $tbutton->signal_connect( clicked => sub{ launch() });
my $sconnect;

$window->show_all();
$pbar->hide;   #needs to be called after show_all

Gtk2->main;

#####################################
sub delete_event {
Gtk2->main_quit;
return FALSE;
}
#######################################
sub launch{
   $pbar->show;
   $tbutton->set_label('Stop Thread');
   $tbutton->signal_handler_block($lconnect);
   $sconnect = $tbutton->signal_connect( clicked => sub{ stop() });
   $shash{'go'} = 1;
  
   Glib::Timeout->add (100, 
                 sub { 
                     if($shash{'go'} == 1){
                     $pbar->pulse;
                     return TRUE;
                       }else{
                           return FALSE;
                           }
		  }
        );
}
##################################################
sub stop{
   print "stopped\n";
   $shash{'go'} = 0;
   $pbar->hide;
   $tbutton->set_label('Run Thread');
   $tbutton->signal_handler_block ($sconnect);
   $tbutton->signal_handler_unblock ($lconnect);
}
#########################################################
sub work{
    $|++; 
    while(1){
       if($shash{'die'} == 1){ goto END }; 
      
       if ( $shash{'go'} == 1 ){

         foreach my $num (1..100){
            $shash{'data'} = $num; 
            print "$num\n";
            select(undef,undef,undef, .5);

            if($shash{'go'} == 0){last}
            if($shash{'die'} == 1){ goto END }; 
           }
       
           $shash{'go'} = 0; #turn off self before returning      
       }else
         { sleep 1 }
    }
END:
}
#####################################################################
sub exit_thr{
  $shash{'die'} = 1;
  $thread->join;
  Gtk2->main_quit;
  return FALSE;
}
__END__



-- 
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html


------------------------------

Date: Sat, 06 Jan 2007 08:32:21 GMT
From: "Arved Sandstrom" <asandstrom@accesswave.ca>
Subject: Re: is Perl used in the Java middle-tier
Message-Id: <p8Jnh.116260$YV4.107416@edtnps89>

<andrew_nuss@yahoo.com> wrote in message 
news:1168018947.208489.229000@11g2000cwr.googlegroups.com...
>
>>
>> Use C#. Then you have regexes with Perl's complexity (of course
>> without Perl's elegance, but you're used to that being a Java
>> programmer).
>
> Does C# have code assertions?

Most languages do (sort of), if you can duplicate the effect of an assert 
using native constructs. Frequently, "if" statements (or their equivalent) 
are the same thing: "if" something is true/not true, then barf/don't barf.

Asserts do have value in that they can be more easily divorced from your 
real code.

AFAIK, C# has asserts, through Debug.Assert.

AHS 




------------------------------

Date: Sat, 6 Jan 2007 14:15:48 +0100
From: "Dr.Ruud" <rvtol+news@isolution.nl>
Subject: Re: is Perl used in the Java middle-tier
Message-Id: <enob1t.fk.1@news.isolution.nl>

Uri Guttman schreef:

> $string =~ /^$begin/ ;

Often better expressed as

  $string =~ /^\Q$begin/ and ...

-- 
Affijn, Ruud

"Gewoon is een tijger."


------------------------------

Date: Fri, 5 Jan 2007 21:09:31 -0600
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: is Perl used in the Java middle-tier
Message-Id: <slrnepu4nb.tm9.tadmc@tadmc30.august.net>

James Willmore <james.willmore@comcast.net> wrote:

> Of course, since Perl 
> doesn't have a "startsWith" method, 


 ... then you can just write one:

     sub startsWith {
        my($str, $search) = @_;

        return 1 if substr($str, 0, length $search) eq $search;
        return 0;
     }

> you're stuck using a regex to 
> find something at the start of a line or scalar value.


No you're not.

Somebody recently said people think of regexes too often, to the
exclusion of alternatives.

Oh, that somebody was you!  :-)


-- 
    Tad McClellan                          SGML consulting
    tadmc@augustmail.com                   Perl programming
    Fort Worth, Texas


------------------------------

Date: Sat, 6 Jan 2007 20:51:24 +1100
From: "Sisyphus" <sisyphus1@nomail.afraid.org>
Subject: Re: join array elements into a string
Message-Id: <459f7275$0$16557$afc38c87@news.optusnet.com.au>


"Perl Lover" <perl.lover@nospam.com> wrote in message
news:459f2218$0$97260$892e7fe2@authen.yellow.readfreenews.net...
> I want to join elements of an array into a string.
> I can use join function, but the problem is that
> one or more elements of the array can contain
> undef values.
> join function spews out error when one of the
> array elements is undef.
>

That's not correct. What you see is a warning message telling you that there
were uninitialized values. Nothing more, nothing less - but there is *no*
error.

In addition to the other (probably preferable) solutions already proposed,
you could simply disable warnings for uninitialized values:

{
no warnings "uninitialized";
join ...... ;
}

Cheers,
Rob




------------------------------

Date: 6 Jan 2007 04:25:06 -0800
From: "foo bar baz qux" <foobarbazqux@hotmail.com>
Subject: Re: join array elements into a string
Message-Id: <1168086306.294620.61840@51g2000cwl.googlegroups.com>

Purl Gurl wrote:
> Perl Lover wrote:
>
> (snipped)
>
> > I am comparing two arrays to determine whether they are same or different.
>
> Other words, are two arrays equal? You have not stated "similar" nor "alike"
> rather "same or different."
>
> if ("@Array1" eq "@Array2")
>   { print "Match"; }
> else
>   { print "No Match"; }
>


#!perl
use warnings;
use strict;
my @Array1 = ( "a", "a", "a", "a", "a", "a" ); # 6 elements
my @Array2 = ( "a a", "a", "a", "a", "a" ); # 5 elements

if ("@Array1" eq "@Array2")
 { print "Match"; }
else
 { print "No Match"; }

C:>perl arrayequal.pl
Match

ROFL - PG considers a six element array to be "equal" to a five element
array.



------------------------------

Date: Sat, 6 Jan 2007 16:38:30 +0100
From: "Dr.Ruud" <rvtol+news@isolution.nl>
Subject: Re: join array elements into a string
Message-Id: <enojib.q4.1@news.isolution.nl>

Jürgen Exner schreef:

> as an alternative you could simple
> stringify the array:
>     $foo = "@array";

That will equalize  qw/a b c/  and  ("a b", "c").

If all elements in the array can only contain printable characters, then
something like this is an alternative:

  $foo = do { no warnings 'uninitialized'; local $" = $;; "@array" }

See perlvar: LIST_SEPARATOR, SUBSCRIPT_SEPARATOR.

-- 
Affijn, Ruud

"Gewoon is een tijger."



------------------------------

Date: Sat, 06 Jan 2007 16:33:18 GMT
From: "Jürgen Exner" <jurgenex@hotmail.com>
Subject: Re: join array elements into a string
Message-Id: <ibQnh.995$us1.303@trndny04>

Dr.Ruud wrote:
> Jürgen Exner schreef:
>
>> as an alternative you could simple
>> stringify the array:
>>     $foo = "@array";
>
> That will equalize  qw/a b c/  and  ("a b", "c").

1: Which is the same behaviour as the OP would get with his approach using 
join()
2: Which I actually pointed out in the part you snipped

If this is a behaviour he wants or not is his call

jue 




------------------------------

Date: Sat, 6 Jan 2007 19:44:59 +1100
From: "Sisyphus" <sisyphus1@nomail.afraid.org>
Subject: Re: Net::SSH installation problems - how do I force local path?
Message-Id: <459f6798$0$9770$afc38c87@news.optusnet.com.au>


"Ishmael" <stahl.karl@gmail.com> wrote in message
news:1168060974.069734.44580@s80g2000cwa.googlegroups.com...
 .
 .
> >
> > See Sherm Pendley's post in the thread "Math::GMP make test fails"
(posted
> > yesterday).
> >
 .
 .
>
> Well, actually this is the same person that posted the previous thread.

Heh ... so it is :-)

>  Sherm's reply was very helpful, but I'm afraid it doesn't apply in
> this case.  His reply is where I got the idea of putting a 'LIBS =>
> ...' line in my Makefile.PL.  Alas, it doesn't do the trick this time
> around.  Somehow, 'make test' is bypassing my explicit path definition.
>  Any ideas?
>

When I go back to your original post in this thread, first thing I notice
is:

>   Warning: prerequisite Math::GMP 1.04 not found.

How does that happen ? You've successfully built Math::GMP (according to the
other thread).

I think it's a good idea to fix that problem first.

What does 'perl -MMath::GMP -e 'print "ok\n"' produce ?

Cheers,
Rob




------------------------------

Date: 6 Jan 2007 12:27:54 -0800
From: "Ishmael" <stahl.karl@gmail.com>
Subject: Re: Net::SSH installation problems - how do I force local path?
Message-Id: <1168115274.500418.248920@51g2000cwl.googlegroups.com>


> When I go back to your original post in this thread, first thing I notice
> is:
>
> >   Warning: prerequisite Math::GMP 1.04 not found.
>
> How does that happen ? You've successfully built Math::GMP (according to the
> other thread).
>
> I think it's a good idea to fix that problem first.
>
> What does 'perl -MMath::GMP -e 'print "ok\n"' produce ?

Same problem - it's looking in the wrong directory.  Here's the error
message:

   Can't load

'/apps/gnu/perl_local/lib/site_perl/5.6.1/sol2.sun4/auto/Math/GMP/GMP.so'
for
   module Math::GMP: ld.so.1: perl: fatal: libgmp.so.3: open failed: No
such file
   or directory at /apps/gnu/perl-5.6.1/lib/sol2.sun4/DynaLoader.pm
line 206.
    at -e line 0
   Compilation failed in require.
   BEGIN failed--compilation aborted.

Now, the only way I know of setting the Perl search path is to use the
PERL5LIB variable, which I've set as shown below.

   echo $PERL5LIB

/home/kstahl/PERL/Digest-1.15:/home/kstahl/PERL/Digest-SHA1-2.11:/home/kstahl/PE

RL/gmp-4.2.1:/home/kstahl/PERL/Math-GMP-2.04:/home/kstahl/PERL/Scalar-List-Utils
   -1.19:/home/kstahl/PERL/Net-SSH-Perl-1.30

As you can see, the path to the correct version of GMP is right there.
Is there something else I should be doing?



------------------------------

Date: Sat, 06 Jan 2007 16:36:20 -0500
From: lucas <lstouder@teksavvy.com>
Subject: regex
Message-Id: <28e3e$45a01650$cef8bf30$16302@TEKSAVVY.COM-Free>

I have this perl oneliner that I'm using to recognize certain file
extentions in a url.  This works, but I was wondering if any of you know of
a better way to write this.

echo "http://fu.bar/test.jpg" | perl -ne 'print if((/\.jpg\n$/i)|
(/\.bmp\n$/i)||(/\.png\n$/i));'

Regards,
-- 
lucas
-------------------------
Perl Coder since 2001
shift || die;
-------------------------


------------------------------

Date: Sat, 06 Jan 2007 21:46:29 GMT
From: "Jürgen Exner" <jurgenex@hotmail.com>
Subject: Re: regex
Message-Id: <VMUnh.1406$312.7@trndny02>

lucas wrote:
> I have this perl oneliner that I'm using to recognize certain file
> extentions in a url.  This works, but I was wondering if any of you
> know of a better way to write this.

Just use File::Basename,  (undef, undef,$suffix) = 
fileparse($fullname,@suffixlist), put the desired extensions as keys in a 
hash, then check for exists() of $suffix in the hash.

jue 




------------------------------

Date: 6 Jan 2007 22:05:10 GMT
From: John Bokma <john@castleamber.com>
Subject: Re: regex
Message-Id: <Xns98B0A3A25DCcastleamber@130.133.1.4>

lucas <lstouder@teksavvy.com> wrote:

> I have this perl oneliner that I'm using to recognize certain file
> extentions in a url.  This works, but I was wondering if any of you
> know of a better way to write this.
> 
> echo "http://fu.bar/test.jpg" | perl -ne 'print if((/\.jpg\n$/i)|
> (/\.bmp\n$/i)||(/\.png\n$/i));'

print if /\.(jpg|bmp|png)$/i

you might want to replace jpg with jpe?g


-- 
John                Experienced Perl programmer: http://castleamber.com/

          Perl help, tutorials, and examples: http://johnbokma.com/perl/


------------------------------

Date: Sat, 06 Jan 2007 17:36:45 -0500
From: lucas <lstouder@teksavvy.com>
Subject: Re: regex
Message-Id: <214f1$45a02479$cef8bf30$24422@TEKSAVVY.COM-Free>

Great!  Thanks a lot guys!
-- 
lucas
-------------------------
Perl Coder since 2001
shift || die;
-------------------------


------------------------------

Date: 6 Jan 2007 09:43:39 -0800
From: "deadpickle" <deadpickle@gmail.com>
Subject: Re: stalling server client program
Message-Id: <1168105419.140762.84030@q40g2000cwq.googlegroups.com>

DJ Stunks wrote:
> deadpickle wrote:
> > This program is designed to transfer a file to a client. When i go to
> > run the program It sends the file once then sits there. The file that
> > is sent is not closed and there fore conatins no data. I'm not sure
> > what the problem is.
> > <snip>
>
> There are dozens of modules out there to accomplish what you're trying
> to do - there's no need to get your hands dirty and introduce errors
> like the one you are struggling with.
>
> How about an IO::All solution?
>
> client:
>
>   #!/usr/bin/perl
>
>   # client
>
>   use strict;
>   use warnings;
>
>   use IO::All;
>
>   my $ip   = 'localhost';
>   my $port = 12345;
>   my $file = shift;
>
>   die "Supply file to be transmitted on command line\n"
>   	if not defined $file;
>
>   my $socket = io( "$ip:$port" );
>   $socket->print($_) for io->file( $file )->getlines;
>
>   __END__
>
> server:
>
>   #!/usr/bin/perl
>
>   # server
>
>   use strict;
>   use warnings;
>
>   use IO::All;
>
>   my $port = 12345;
>
>   my $listener = io( ":$port" )->accept;
>   print while $_ = $listener->getline;
>
>   __END__
>
> HTH,
> -jp

Your right this looks hugly simplified but, when I run a syntax check I
get the error "Can't locate IO/All.pm in @INC (@INC contains:
C:/Perl/site/lib C:/Perl/lib .) at serverAll.pl line 4." not sure what
that means, any idea? also will this be able to transfer the file over
and over every 5 seconds?



------------------------------

Date: Sat, 06 Jan 2007 19:10:03 GMT
From: "Nospam" <nospam@home.com>
Subject: substitutions in a large file
Message-Id: <fuSnh.13280$RL5.7456@newsfe2-gui.ntli.net>

Basically I have a local html file, called file1.html it has a series of
links
(with a particular domain name) in addition to the html code, I am trying to
follow each of these links (based on the regular expression /on\.fe/) each
of
these links, in their content have a link to another page, (I would like to
capture this particular page based on a regular expression /www\.arax/), and
substitute for each link (with regular expression /on\.fe/)in file1.html
with
their corresponding link (with regular expression/www\.arax/) So far this is
what I have come up with, and am a little stuck

#! perl\bin\perl

use strict;
use warnings;
use WWW::Mechanize;

my $mech = WWW::Mechanize->new();



open(FILE, "< file1.html") || print "Unable to open the file file1 \n"
+;





while (<FILE>)
{
     for my $l ($mech->links) {
    my $url  = $l->url;
    my $desc = $l->text;
    my $new  = $url;
       $new =~ s/on\.fe/arax.com/;

    print "concerning $desc, $url should be $new\n";

    # $mech->get( $new );
}


}


close(FILE);


If it helps a sample of the html code from file1.html :

<li class="MsoNormal" style="line-height: 18.0pt; text-autospace:
ideograph-numeric ideograph-other; background: white">
  <span style="font-size: 11.0pt; font-family: Tahoma">
  <a href="http://...online.feeds.com/link1/" target="_blank" style="c
+olor:
blue; text-decoration: underline; text-underline: single">
  <span style="color: #336699; text-decoration: none">Links
  Part 2</span></a> </span></li>
  <li class="MsoNormal" style="line-height: 18.0pt; text-autospace:
ideograph-numeric ideograph-other; background: white">
  <span style="font-size: 11.0pt; font-family: Tahoma">
  <a href="http://...online.feeds.com/link2/" target="_blank" style="c
+olor:
blue; text-decoration: underline; text-underline: single">
  <span style="color: #336699; text-decoration: none">Links
  Part 3</span></a> </span></li>
  <li class="MsoNormal" style="line-height: 18.0pt; text-autospace:
ideograph-numeric ideograph-other; background: white">
  <span style="font-size: 11.0pt; font-family: Tahoma">
  <a href="http://...online.feeds.com/link3/" target="_blank" style="c
+olor:
blue; text-decoration: underline; text-underline: single">
  <span style="color: #336699; text-decoration: none">Links
  Part 4</span></a> </span></li>
  <li class="MsoNormal" style="line-height: 18.0pt; text-autospace:
ideograph-numeric ideograph-other; background: white">
  <span style="font-size: 11.0pt; font-family: Tahoma">
  <a href="http://...online.feeds.com/link4/" target="_blank" style="c
+olor:
blue; text-decoration: underline; text-underline: single">
  <span style="color: #336699; text-decoration: none">Links
  Part 5</span></a> </span></li>
[download]
The contents of the link http://...online.feeds.com/link1/ for example is:
  <body>
  ...
      </td></tr><tr><td
style="height:81%;width:100%;padding:0;text-align:left;"><embed
src="http://...arax.../v/gomlckZfGYU..." </embed>  </td>
  </tr>
  <tr>
  <td style="height:13%;width:100%;padding:0;text-align:left;">




------------------------------

Date: 6 Jan 2007 21:09:10 GMT
From: John Bokma <john@castleamber.com>
Subject: Re: substitutions in a large file
Message-Id: <Xns98B09A23FAD06castleamber@130.133.1.4>

"Nospam" <nospam@home.com> wrote:

> Basically I have a 

Deja vu

-- 
John                Experienced Perl programmer: http://castleamber.com/

          Perl help, tutorials, and examples: http://johnbokma.com/perl/


------------------------------

Date: Sat, 06 Jan 2007 09:41:02 -0500
From: "Steven N. Hirsch" <shirsch@adelphia.net>
Subject: Re: Unsecured scripts and site hacking?
Message-Id: <8I-dncRUyvxjKQLYnZ2dnUVZ_r_inZ2d@adelphia.com>

Lawrence Statton XE2/N1GAK wrote:
> "Alison" <invalid@,hs,fjsldkjfhlkj.com> writes:
>> How else would you suggest I upload 50MB weekly updates of adult pornography
>> to my site?
>>
> 
> Umm, the same way one of my clients handles their several hundred
> megabytes a DAY ... rsync.   Don't like rsync, use scp.  Like the FTP
> user interface, use sftp.  
> 
> You are clearly clue retardant.  *plonk*

The actual Alison who started this thread has been involved in computing 
since before most of you were born and, I'd venture to say, has no 
interest nor involvement with adult entertainment.  If you look closely, 
it's obvious that one of the regularly-scheduled trolls has jumped in 
and started stirring the pot.



------------------------------

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 V11 Issue 3
************************************


home help back first fref pref prev next nref lref last post