Loading ...
Sorry, an error occurred while loading the content.

RE: [PBML] Problem with function getquotaroot in IMAP::Client

Expand Messages
  • lRobert Lee Binkley
    # Display the IMAP resource usage on the user s post office server. use strict; use warnings FATAL = all ; use Cyrus::IMAP; use Getopt::Std; sub usage(;$);
    Message 1 of 4 , Oct 29, 2009
    • 0 Attachment
      # Display the IMAP resource usage on the user's post office server.



      use strict;

      use warnings FATAL => 'all';

      use Cyrus::IMAP;

      use Getopt::Std;



      sub usage(;$);

      sub print_quota($$$$$);

      sub send_command($);

      sub quota_callback(@);

      sub quotaroot_callback(@);

      sub capability_callback(@);

      sub close_and_errorout($);

      sub close_connection();

      sub errorout($);



      sub usage(;$) {

      print STDERR "mailquota: $_[0]\n" if $_[0];

      print STDERR <<EOF;

      Usage: mailquota [<options>] [<user>]

      Options:

      -h <host> query <host> instead of default post office server

      -m <mailbox> query for <mailbox> (default is INBOX)

      -n be silent unless usage % is above the threshold

      -u <percent> usage % threshold (default is 90); implies -n

      -d turn on debugging

      EOF

      exit 1;

      }



      my $need_header = 1;

      my $root_width = 16;

      my $num_width = 10;

      my $percent_width = 5;

      my $format = "%-${root_width}.${root_width}s" .

      " %${num_width}s %${num_width}s %${percent_width}s" .

      " %${num_width}s %${num_width}s %${percent_width}s\n";



      # Parse the command line arguments.

      my %opts;

      getopts('dh:m:nu:', \%opts) || usage;

      my $username = shift @ARGV || $ENV{'USER'} || getlogin || (getpwuid($<))[0]
      ||

      errorout "Cannot determine user name";



      usage "Too many arguments" if @ARGV > 0;

      my $debug = $opts{'d'};

      my $warn_only = $opts{'n'};

      my $usage_threshold = $opts{'u'};

      my $host = $opts{'h'} || (split(" ", `hesinfo $username pobox`))[1] ||

      errorout "Cannot find Post Office server for $username";

      my $mbox = $opts{'m'} || "INBOX";



      # Validate the usage percentage threshold, allowing a trailing %.

      # Setting the threshold implies we should only display quotas

      # for which any resource usage is above the threshold.

      if (defined $usage_threshold) {

      chop $usage_threshold if $usage_threshold =~ /^\d+%$/;

      usage "-u argument must be numeric" if $usage_threshold !~ /^\d+$/;

      $warn_only = 1;

      } else {

      $usage_threshold = 90;

      }



      # Connect to the IMAP server, check for the QUOTA extension, and

      # authenticate.

      my $client = Cyrus::IMAP->new($host) ||

      errorout "Cannot connect to IMAP server on $host";

      my $caps = '';

      $client->addcallback({-trigger => 'CAPABILITY',

      -callback => \&capability_callback,

      -rock => \$caps});

      send_command "CAPABILITY";

      $caps =~ '\bQUOTA\b' ||

      close_and_errorout "$host does not support the IMAP QUOTA extension";

      $client->authenticate(-authz => $username) ||

      close_and_errorout "Cannot authenticate to $host";



      # Send the GETQUOTAROOT command, which returns both the QUOTA and

      # QUOTAROOT responses. Quota information will be displayed via

      # the QUOTA callback.

      $client->addcallback({-trigger => 'QUOTA',

      -callback => \"a_callback});

      $client->addcallback({-trigger => 'QUOTAROOT',

      -callback => \"aroot_callback});

      send_command "GETQUOTAROOT \"$mbox\"";



      # We are done talking to the IMAP server; close down the connection.

      close_connection();



      # Print the quota information for the given quota root and its

      # storage and message resource values.

      sub print_quota($$$$$) {

      my ($root, $storage_used, $storage_max, $message_used, $message_max) =
      @_;

      my $storage_percent;

      my $storage_percent_out;

      my $message_percent;

      my $message_percent_out;



      # Calculate the usage percentages, and format for output.

      if ($storage_max) {

      $storage_percent = ($storage_used / $storage_max) * 100;

      $storage_percent_out = sprintf("%.0f%%", $storage_percent);

      }

      if ($message_max) {

      $message_percent = ($message_used / $message_max) * 100;

      $message_percent_out = sprintf("%.0f%%", $message_percent);

      }



      # Skip this quota if we are only displaying usages above the

      # specified threshold.

      return unless (!$warn_only ||

      (defined $storage_percent &&

      $storage_percent >= $usage_threshold) ||

      (defined $message_percent &&

      $message_percent >= $usage_threshold));



      # Print a header if this is the first line of output.

      if ($need_header) {

      printf($format,

      "Quota",

      "KB Used", "KB Max", "KB %",

      "# Msgs", "# Max", "# %");

      $need_header = 0;

      }

      printf($format,

      $root,

      defined $storage_used ? $storage_used : '-',

      defined $storage_max ? $storage_max : '-',

      defined $storage_percent_out ? $storage_percent_out : '-',

      defined $message_used ? $message_used : '-',

      defined $message_max ? $message_max : '-',

      defined $message_percent_out ? $message_percent_out : '-');

      }



      # Subroutine to send a command to the IMAP server, and wait for the

      # response; any defined callbacks for the response are invoked.

      # If the server response indicates failure, we error out.

      sub send_command($) {

      print "Sending: $_[0]\n" if $debug;

      my ($status, $text) = $client->send('', '', $_[0]);

      print "Response: status $status, text $text\n" if $debug;

      errorout "Premature end-of-file on IMAP connection to $host"

      if $status eq 'EOF';

      close_and_errorout "IMAP error for $mbox on $host: $text"

      if $status ne 'OK';

      }



      # Callback subroutine to parse the QUOTA response.

      # The "-text" hash element contains the quota root name, and a list

      # of quota resource names, usages, and limits. Recognized names are

      # STORAGE (sum of message sizes, in kilobytes) and MESSAGE (number of

      # messages). See RFC 2087.

      sub quota_callback(@) {

      my %cb = @_;

      my ($root, $quotalist);

      print "In QUOTA callback: text $cb{-text}\n" if $debug;

      if (($root, $quotalist) = ($cb{-text} =~ /(\S*)\s+\((.*)\)/io)) {

      my ($storage_used, $storage_max, $message_used, $message_max);

      while ($quotalist) {

      my ($resource, $used, $max);

      ($resource, $used, $max, $quotalist) = split /\s/, $quotalist, 4;

      last unless $max;

      $resource = uc $resource;

      if ($resource eq "STORAGE") {

      $storage_used = $used;

      $storage_max = $max;

      }

      elsif ($resource eq "MESSAGE") {

      $message_used = $used;

      $message_max = $max;

      }

      }

      print_quota($root, $storage_used, $storage_max,

      $message_used, $message_max)

      if (defined $storage_max || defined $message_max);

      }

      }



      # Callback subroutine to parse the QUOTAROOT response. The "-text"

      # hash element contains the mailbox name, and zero or more quota root

      # names. This is currently used for debugging only.

      sub quotaroot_callback(@) {

      my %cb = @_;

      print "In QUOTAROOT callback: text $cb{-text}\n" if $debug;

      }



      # Callback subroutine to parse the CAPABILITY response. The "-rock" hash

      # element is a reference to the string in which to store the space-separated

      # capability names.

      sub capability_callback(@) {

      my %cb = @_;

      print "In CAPABILITY callback: keyword $cb{-keyword}, text $cb{-text}\n"

      if $debug;

      ${$cb{-rock}} = $cb{-text};

      }



      # Close the connection to the IMAP server, and error out.

      sub close_and_errorout($) {

      close_connection();

      errorout $_[0];

      }



      # Logout from the IMAP server, and close the connection.

      sub close_connection() {

      $client->send('', '', "LOGOUT");

      # Set the client reference to undef, so that perl invokes the

      # destructor, which closes the connection. Note that if we invoke

      # the destructor explicitly here, then perl will still invoke it

      # again when the program exits, thus touching memory which has

      # already been freed.

      $client = undef;

      }



      sub errorout($) {

      print STDERR "mailquota: $_[0]\n";

      exit 1;

      }





      From: perl-beginner@yahoogroups.com [mailto:perl-beginner@yahoogroups.com]
      On Behalf Of Shameem Ahamed
      Sent: Thursday, October 29, 2009 12:56 PM
      To: perl-beginner@yahoogroups.com
      Subject: [PBML] Problem with function getquotaroot in IMAP::Client





      Hi,

      I am using the IMAP::Client for automating the quota check
      for some of the users. My script was fairly straight, and I ran in to
      the below error, while running the script. The error returned by the
      $imap->error function is

      QUOTA not supported for GETQUOTAROOT command at imap.pl

      As per the function description given in the page

      http://search.cpan.org/~conteb/IMAP-Client-0.13/lib/IMAP/Client.pm

      The getquotaroot function accepts the mail box name only.

      My code snippet is given below

      my %quota=$imap->getquotaroot('INBOX') || die $imap->error();
      print "Quota: $quota{'STORAGE'} \n";

      Please help me to debug this issue.

      Regards,
      Shameem





      [Non-text portions of this message have been removed]
    • Yanto asnawi
      Hello,   Can some one help me?   How to get data from website, then save to file.   example from  http://www.website.com/page.html   TIA Yanto Asnawi
      Message 2 of 4 , Nov 10, 2009
      • 0 Attachment
        Hello,
         
        Can some one help me?
         
        How to get data from website, then save to file.
         
        example from  http://www.website.com/page.html
         
        TIA
        Yanto Asnawi

        [Non-text portions of this message have been removed]
      • merlyn@stonehenge.com
        ... Yanto Hello, Yanto   Yanto Can some one help me? Yanto   Yanto How to get data from website, then save to file. Yanto   Yanto example from
        Message 3 of 4 , Nov 10, 2009
        • 0 Attachment
          >>>>> "Yanto" == Yanto asnawi <yanto_asnawi@...> writes:

          Yanto> Hello,
          Yanto>  
          Yanto> Can some one help me?
          Yanto>  
          Yanto> How to get data from website, then save to file.
          Yanto>  
          Yanto> example from  http://www.website.com/page.html

          LWP::Simple is your friend. Install it, then read the docs.
          Plenty of examples.


          --
          Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
          <merlyn@...> <URL:http://www.stonehenge.com/merlyn/>
          Smalltalk/Perl/Unix consulting, Technical writing, Comedy, etc. etc.
          See http://methodsandmessages.vox.com/ for Smalltalk and Seaside discussion
        Your message has been successfully submitted and would be delivered to recipients shortly.